diff options
438 files changed, 11979 insertions, 7968 deletions
diff --git a/gcc/ChangeLog.fortran-dev b/gcc/ChangeLog.fortran-dev new file mode 100644 index 00000000000..8291ab6da74 --- /dev/null +++ b/gcc/ChangeLog.fortran-dev @@ -0,0 +1,3 @@ +2013-04-01 Tobias Burnus <burnus@net-b.de> + + * dwarf2out.h (array_descr_info): Change dim to 15. diff --git a/gcc/fortran/ChangeLog.fortran-dev b/gcc/fortran/ChangeLog.fortran-dev new file mode 100644 index 00000000000..9109ddfcd87 --- /dev/null +++ b/gcc/fortran/ChangeLog.fortran-dev @@ -0,0 +1,343 @@ +2016-20-10 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_conv_expr_descriptor): Detect class object + with an abstract declared type. Use the type of the data field + and the dynamic element length from the symbol backend_decl. + * trans-decl.c (gfc_trans_deferred_vars): Initialize the + descriptor of allocatable class arrays.. + +2016-09-10 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_alloc_allocatable_for_assignment): Put + calculation of element length before setting of extent and sm + so that the element length field is set, ready for this. + * trans-intrinsic.c (conv_isocbinding_subroutine): Set the elem + len field of the descriptor. + * trans-stmt.c (gfc_conv_intrinsic_size): The one that is + subtracted from arg_2 has to be an integer_type. + +2016-09-07 Paul Thomas <pault@gcc.gnu.org> + + * trans-expr.c (gfc_conv_scalar_to_descriptor): Correct error + in setting 'type'. + (gfc_conv_intrinsic_to_class): Use the expression typespec for + unlimited polymorphic classes. + * trans-intrinsic.c (conv_isocbinding_subroutine): Set the elem + len field of the descriptor. + * trans-stmt.c (trans_associate_var): Build a null descriptor + for the associate name, if the target is unlimited polymorphic, + and copy the dtype, element length and stride measures to the + associate name. + +2016-09-07 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_build_null_descriptor): Set the element + length to zero for deferred types. + (gfc_trans_static_array_pointer): Initialize deferred string + length to zero. + (gfc_array_init_size): Restore chunk for calculating the ubound + of array constructor sources. + * trans-expr.c (gfc_conv_scalar_to_descriptor): If the type is + NULL_TREE, set the element length to zero. + (gfc_trans_pointer_assignment): Copy the element length. + trans-io.c (gfc_build_io_library_fndecls): Update arguments for + namelist transfers. + (transfer_namelist_element): Calculate element length and + update arguments to transfer calls. + +2016-08-30 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_array_init_size): Remove argument 'ts'. + Use the 'expr' typespec instead. + (gfc_array_allocate): Remove the typespec argument in the call + to gfc_array_init_size. + * trans-expr.c (gfc_conv_scalar_to_descriptor): Use the type + of the scalar to get the element size, rather than that of + the descriptor. + (gfc_conv_intrinsic_to_class): Provide the typespec for the + call to gfc_conv_scalar_to_descriptor. + (gfc_conv_component_ref): Whitespace. + (gfc_conv_procedure_call): Provide the typespec as above. + (gfc_conv_structure): Provide rank for call to + gfc_conv_initializer. + (gfc_trans_pointer_assignment): Update the rank field in the + case of rank remap. + * trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Provide the + typespec for the calls to gfc_conv_scalar_to_descriptor. Change + call to gfc_get_dtype_rank_type into gfc_get_dtype. Provide + extra arguments for call to gfc_trans_create_temp_array. + (conv_caf_send): As previous and eliminate 'tmp2'. + (gfc_conv_intrinsic_sizeof): Use the elem_len field. + +2014-06-14 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_conv_array_parameter): Assign 'old_desc' + to 'new_desc' rather than some of the components. + +2014-06-03 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_conv_expr_descriptor): Use the type of the + expression for the type of the array. The element length should + be set initially to the descriptor element type so that the + stride measure is calculated correctly. + * trans-stmt.c (gfc_conv_elemental_dependencies): Use the type + of the elements of the descriptor for 'temptype'. Change the + comment accordingly. + +2014-05-22 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c (gfc_conv_descriptor_stride_get, + gfc_conv_descriptor_stride_get): Only use 'elem_len' field for + element size. + * trans-stmt.c (trans_associate_var): Eliminate redundant + declaration of 'desc'. Use 'sm' and 'elem_len' fields directly + to calculate offset. + +2013-06-05 Tobias Burnus <burnus@net-b.de> + + * trans-array.c (gfc_array_init_size): Remove superfluous + "ts" argument due to trunk merging. + (gfc_array_allocate): Pass only one ts. + +2013-05-07 Tobias Burnus <burnus@net-b.de> + + * trans-intrinsic.c (gfc_conv_intrinsic_bound, + gfc_conv_intrinsic_size): Set argse.data_not_needed. + +2013-05-07 Tobias Burnus <burnus@net-b.de> + + * trans-array.c (gfc_conv_descriptor_stride_get, + gfc_conv_descriptor_stride_set): Use elem_len, unless it is + a nonstring intrinsic type for which size_in_bytes is used. + (gfc_array_init_size): Set elem_len before handling the + strides. + * trans-expr.c (gfc_conv_subref_array_arg): Remove no-op + extent shifting code. + +2013-05-06 Tobias Burnus <burnus@net-b.de> + + * trans-array.c (gfc_conv_ss_startstride, set_loop_bounds): Handle + GFC_ISYM_SHAPE in the scalarizer. + (gfc_array_init_size, gfc_conv_expr_descriptor): Ensure that + extent is never negative except for assumed size arrays. + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Optimizations + of the bounds handling. + (gfc_conv_intrinsic_size): Handle SIZE and SHAPE directly without + calling the library. + (gfc_conv_intrinsic_function, gfc_add_intrinsic_ss_code, + gfc_walk_intrinsic_bound, gfc_is_intrinsic_libcall, + gfc_walk_intrinsic_function): Handle SHAPE. + +2013-04-30 Tobias Burnus <burnus@net-b.de> + + * libgfortran.h (GFC_TYPE_MASK, GFC_TYPE_KIND_SHIFT, + GFC_TYPE_INTEGER, GFC_TYPE_LOGICAL, GFC_TYPE_REAL, GFC_TYPE_COMPLEX, + GFC_TYPE_CHARACTER, GFC_TYPE_STRUCT, GFC_TYPE_CPTR, GFC_TYPE_CFUNPTR, + GFC_TYPE_OTHER): New. + (GFC_DTYPE_TYPE_SHIFT, GFC_DTYPE_TYPE_MASK, GFC_DTYPE_SIZE_SHIFT): + Remove. + (bt): Reorder. + * trans-array.c (OFFSET_FIELD, ATTR_FIELD): Change value (swap order). + (gfc_conv_descriptor_rank_set, gfc_conv_descriptor_attr_set, + gfc_build_null_descriptor): Change data type. + (gfc_trans_create_temp_array): Add ts and strlen arguments. + (gfc_trans_array_constructor_subarray, trans_array_constructor, + gfc_alloc_allocatable_for_assignment): Update call. + (gfc_conv_loop_setup, gfc_array_init_size): Ditto; add ts argument. + (gfc_array_allocate, gfc_conv_array_initializer, + gfc_conv_expr_descriptor): Update calls. + (gfc_conv_expr_descriptor): Properly set the elem_len. + (structure_alloc_comps, gfc_trans_deferred_array): Update + get_dtype call. + * trans-array.h (gfc_trans_create_temp_array, gfc_conv_loop_setup, + gfc_build_null_descriptor): Update prototype. + * trans-decl.c (gfc_trans_deferred_vars, gfc_trans_deferred_vars): + Update calls. + * trans-expr.c (gfc_conv_scalar_to_descriptor, + realloc_lhs_loop_for_fcn_call): Take ts argument. + (gfc_conv_class_to_class, gfc_conv_subref_array_arg, + gfc_conv_procedure_call, gfc_conv_procedure_call, + gfc_conv_initializer, gfc_trans_subarray_assign, + gfc_trans_pointer_assignment, gfc_trans_arrayfunc_assign, + gfc_trans_assignment_1): Update calls. + * trans-intrinsic.c (trans_this_image): Change to extent. + (gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count, + gfc_conv_intrinsic_arith, gfc_conv_intrinsic_dot_product, + gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval, + gfc_conv_intrinsic_transfer, conv_isocbinding_subroutine): Update + calls. + * trans-io.c (transfer_namelist_element, transfer_array_component, + gfc_trans_transfer): Update calls. + * trans-stmt.c (gfc_conv_elemental_dependencies, gfc_trans_call, + trans_associate_var, generate_loop_for_temp_to_lhs, + generate_loop_for_rhs_to_temp, compute_inner_temp_size, + gfc_trans_pointer_assign_need_temp, gfc_evaluate_where_mask, + gfc_trans_where_assign, gfc_copy_loopinfo_to_se): Ditto. + * trans-types.c (gfc_init_types, gfc_get_dtype): Update dtype + handling. + (gfc_get_array_descriptor_base): Change data types of the + descriptor. + (struct gfc_array_descriptor): Update comment. + * trans-types.h (gfc_get_dtype): Update prototype. + * trans.c (gfc_build_final_call): Update calls. + +2013-04-30 Tobias Burnus <burnus@net-b.de> + + * trans-array.c (gfc_trans_dummy_array_bias, get_std_lbound, + gfc_alloc_allocatable_for_assignment): Change ubound to extent. + * trans-expr.c (gfc_trans_alloc_subarray_assign): Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Ditto. + +2013-04-25 Tobias Burnus <burnus@net-b.de> + + * libgfortran.h (GFC_ATTRIBUTE_*): New defines. + * trans-array.c (gfc_conv_descriptor_elem_len, + gfc_conv_descriptor_elem_len_get, + gfc_conv_descriptor_elem_len_set, gfc_conv_descriptor_rank_set, + gfc_conv_descriptor_version_set, gfc_conv_descriptor_attr_set): + New functions. + (gfc_build_null_descriptor, gfc_trans_static_array_pointer, + gfc_trans_create_temp_array, gfc_conv_array_initializer, + gfc_conv_expr_descriptor, structure_alloc_comps): Fill new fields at + decl time/DT-alloc time. + (gfc_conv_descriptor_size_1, get_full_array_size, + gfc_alloc_allocatable_for_assignment): Use extent directly. + * trans-array.h (gfc_conv_descriptor_elem_len_get, + gfc_conv_descriptor_elem_len_set, gfc_conv_descriptor_rank_set, + gfc_conv_descriptor_version_set, gfc_conv_descriptor_attr_set): New + prototype. + * trans-common.c (create_common): Update calls. + * trans-decl.c (gfc_get_symbol_decl, get_proc_pointer_decl, + gfc_trans_deferred_vars, gfc_emit_parameter_debug_info): Ditto. + * trans-expr.c (gfc_conv_scalar_to_descriptor, + class_array_data_assign, gfc_conv_derived_to_class, + gfc_conv_class_to_class, gfc_conv_initializer, + gfc_trans_pointer_assignment, fcncall_realloc_result): Set new fields. + (gfc_conv_structure): Update calls. + (gfc_set_interface_mapping_bounds, + gfc_conv_subref_array_arg): Use extent directly. + * trans-intrinsic.c (size_of_string_in_bytes): Remove static. + * trans-io.c (transfer_namelist_element): Pass elem_size. + * trans-types.c (gfc_get_array_descriptor_base): Add "attribute" field. + * trans.h (size_of_string_in_bytes): New prototype. + (gfc_get_module_backend_decl): Update prototype. + +2013-04-01 Tobias Burnus <burnus@net-b.de> + + * libgfortran.h (GFC_MAX_DIMENSIONS): Change to 15. + (GFC_DTYPE_RANK_MASK): Remove. + * trans-array.c (RANK_FIELD): New define. + (gfc_conv_descriptor_rank): Use rank field. + (gfc_trans_create_temp_array, gfc_array_init_size, + gfc_conv_expr_descriptor, + gfc_alloc_allocatable_for_assignment): Set rank field. + * trans-expr.c (gfc_conv_scalar_to_descriptor, + class_array_data_assign, gfc_conv_derived_to_class, + gfc_conv_class_to_class, gfc_trans_pointer_assignment, + fcncall_realloc_result): Ditto. + * trans-intrinsic.c (conv_isocbinding_subroutine): Ditto. + * trans-io.c (gfc_build_io_library_fndecls, + transfer_namelist_element): Pass rank as extra argument. + * trans-types.c (gfc_get_element_type, gfc_get_dtype): Don't + add the rank to dtype. + (gfc_get_array_descriptor_base): New "rank" field. + +2013-03-31 Tobias Burnus <burnus@net-b.de> + + * trans-intrinsic.c (conv_isocbinding_subroutine): Fix + merge-resolution bug. + +2013-03-31 Tobias Burnus <burnus@net-b.de> + + * trans-array.c (VERSION_FIELD): New define. + (ELEM_LEN_FIELD): Renamed from SIZE_FIELD, reordered the fields. + (gfc_build_null_descriptor): Also set version field (to 1). + * trans-types.c (gfc_get_array_descriptor_base): Rename "size" to + "elem_len" and move up, add "version" field. + +2012-07-20 Tobias Burnus <burnus@net-b.de> + + * trans-expr.c (conv_isocbinding_procedure): For C_F_Pointer, + directly set extent and sm instead of using ubound and stride. + +2012-07-15 Tobias Burnus <burnus@net-b.de> + + * trans-intrinsic.c (gfc_conv_intrinsic_size, + gfc_conv_intrinsic_sizeof): Replace (ubound-lbound+1) calculation + by "extent". + * trans-expr.c (fcncall_realloc_result): Ditto. + * trans-io.c (gfc_convert_array_to_string): Ditto. + * trans-openmp.c (gfc_omp_clause_default_ctor, + gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op, + gfc_trans_omp_array_reduction): Ditto. + * trans-array.c (array_parameter_size): Ditto. + (gfc_grow_array): Ditto - and fix size calculation for realloc. + +2012-07-15 Tobias Burnus <burnus@net-b.de> + + * trans-intrinsic.c (gfc_conv_associated): Compare sm + instead of stride. + +2012-03-12 Tobias Burnus <burnus@net-b.de> + + * trans-types.c (gfc_get_array_descriptor_base): Rename "data" + to "base_addr". + +2012-03-11 Tobias Burnus <burnus@net-b.de> + + * trans-array.c (UBOUND_SUBFIELD, STRIDE_SUBFIELD): Remove. + (LBOUND_SUBFIELD, EXTENT_SUBFIELD, SM_SUBFIELD): Change value. + (gfc_conv_descriptor_stride): Remove. + (gfc_conv_descriptor_stride_set): Only set "sm". + (gfc_conv_descriptor_ubound): Remove. + (gfc_conv_descriptor_ubound_set): Only set "extent" + (gfc_conv_shift_descriptor_lbound): Remove ubound-setting call. + (gfc_conv_array_sm, gfc_conv_array_extent): New functions. + * trans-array.h (gfc_conv_array_sm, gfc_conv_array_extent): New + prototypes. + * trans-types.c (gfc_get_desc_dim_type): Remove stride/ubound, + rename and reorder according to TS29113. + * trans-io.h (transfer_namelist_element): Pass extent/sm instead + of ubound/stride. + +2012-03-10 Tobias Burnus <burnus@net-b.de> + + * trans-array.c (CAF_TOKEN_FIELD): Set to the correct value. + (gfc_conv_descriptor_ubound_get, gfc_conv_descriptor_ubound_set): + Remove bogus byte-size handling, correctly handle lower bounds + which don't start with unity. + (gfc_conv_shift_descriptor_lbound): Reorder to make sure that + lbound comes before ubound. + * trans-expr.c (gfc_conv_subref_array_arg, + gfc_trans_alloc_subarray_assign): Ditto. + +2010-09-01 Paul Thomas <pault@gcc.gnu.org> + + * trans-array.c : Define and subsequently undefine descriptor + SIZE_FIELD, SM_SUBFIELD and EXTENT_SUBFIELD. Change the offset + for DIMENSION_FIELD. + (gfc_data_field_from_base_field): New function. + (gfc_conv_descriptor_data_addr): Call it to maintain API. + (gfc_dimension_field_from_base_field): New function. + (gfc_conv_descriptor_dimension): Call it. + (gfc_conv_descriptor_stride_get): Compute the stride from the + 'sm' field. + (gfc_conv_descriptor_stride_set): Compute and set 'sm' field. + (gfc_conv_descriptor_sm, gfc_conv_descriptor_sm_get, + gfc_conv_descriptor_sm_set): New functions. + (gfc_conv_descriptor_extent, gfc_conv_descriptor_extent_get, + gfc_conv_descriptor_extent_set): New functions. + (gfc_conv_descriptor_ubound_get): Compute the ubound from the + 'extent' field. + (gfc_conv_descriptor_ubound_set): Compute and set 'extent' + field. + trans-array.h: New prototypes for gfc_conv_descriptor_sm_get, + gfc_conv_descriptor_extent_get, gfc_data_field_from_base_field, + gfc_dimension_field_from_base_field,gfc_conv_descriptor_sm_set, + and gfc_conv_descriptor_extent_set. + trans-types.c (gfc_get_desc_dim_type): Add 'sm' and 'extent' + fields. + (gfc_get_array_descriptor_base): Add 'size' field. + (gfc_get_array_descr_info): Call gfc_data_field_from_base_field + and gfc_dimension_field_from_base_field instead of using the + field offsets explicitly. diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index e9132506367..eb6b7860d42 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -148,22 +148,39 @@ typedef enum #define GFC_STDOUT_UNIT_NUMBER 6 #define GFC_STDERR_UNIT_NUMBER 0 +#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_TYPE_MASK 0xFF +#define GFC_TYPE_KIND_SHIFT 8 + +/* Array-descriptor attributes, see ISO_Fortran_binding.h. */ +#define GFC_ATTRIBUTE_POINTER 1 +#define GFC_ATTRIBUTE_ALLOCATABLE 2 +#define GFC_ATTRIBUTE_OTHER 3 + +/* Array-descriptor basic types, see ISO_Fortran_binding.h. */ +#define GFC_TYPE_INTEGER 1 +#define GFC_TYPE_LOGICAL 2 +#define GFC_TYPE_REAL 3 +#define GFC_TYPE_COMPLEX 4 +#define GFC_TYPE_CHARACTER 5 +#define GFC_TYPE_STRUCT 6 +#define GFC_TYPE_CPTR 7 +#define GFC_TYPE_CFUNPTR 8 +#define GFC_TYPE_OTHER -1 + +/* Array-descriptor attributes, see ISO_Fortran_binding.h. */ +#define GFC_ATTRIBUTE_POINTER 1 +#define GFC_ATTRIBUTE_ALLOCATABLE 2 +#define GFC_ATTRIBUTE_OTHER 3 -#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 used in the run-time library for IO. */ typedef enum { BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX, - BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID, + BT_CHARACTER, BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID, BT_ASSUMED, BT_UNION } bt; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 2699a767dbf..7706ba95423 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -123,14 +123,18 @@ gfc_array_dataptr_type (tree desc) Don't forget to #undef these! */ #define DATA_FIELD 0 -#define OFFSET_FIELD 1 -#define DTYPE_FIELD 2 -#define DIMENSION_FIELD 3 -#define CAF_TOKEN_FIELD 4 - -#define STRIDE_SUBFIELD 0 -#define LBOUND_SUBFIELD 1 -#define UBOUND_SUBFIELD 2 +#define ELEM_LEN_FIELD 1 +#define VERSION_FIELD 2 +#define RANK_FIELD 3 +#define ATTR_FIELD 4 +#define DTYPE_FIELD 5 +#define OFFSET_FIELD 6 +#define DIMENSION_FIELD 7 +#define CAF_TOKEN_FIELD 8 + +#define LBOUND_SUBFIELD 0 +#define EXTENT_SUBFIELD 1 +#define SM_SUBFIELD 2 /* This provides READ-ONLY access to the data field. The field itself doesn't have the proper type. */ @@ -178,6 +182,16 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value) } +/* This is trivial but unifies the API. */ + +tree +gfc_data_field_from_base_field (tree field) +{ + gcc_assert (DATA_FIELD == 0); + return gfc_advance_chain (field, DATA_FIELD); +} + + /* This provides address access to the data field. This should only be used by array allocation, passing this on to the runtime. */ @@ -189,8 +203,7 @@ gfc_conv_descriptor_data_addr (tree desc) type = TREE_TYPE (desc); gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - field = TYPE_FIELDS (type); - gcc_assert (DATA_FIELD == 0); + field = gfc_data_field_from_base_field (TYPE_FIELDS (type)); t = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); @@ -198,6 +211,37 @@ gfc_conv_descriptor_data_addr (tree desc) } static tree +gfc_conv_descriptor_elem_len (tree desc) +{ + tree type; + tree field; + + type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + + field = gfc_advance_chain (TYPE_FIELDS (type), ELEM_LEN_FIELD); + gcc_assert (field != NULL_TREE && TREE_TYPE (field) == size_type_node); + + return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + desc, field, NULL_TREE); +} + +tree +gfc_conv_descriptor_elem_len_get (tree desc) +{ + return gfc_conv_descriptor_elem_len (desc); +} + +void +gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree desc, + tree value) +{ + tree t = gfc_conv_descriptor_elem_len (desc); + gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)); +} + + +static tree gfc_conv_descriptor_offset (tree desc) { tree type; @@ -238,24 +282,80 @@ 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_CODE (TREE_TYPE (field)) == INTEGER_TYPE); return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); } +tree +gfc_dimension_field_from_base_field (tree field) +{ + return gfc_advance_chain (field, DIMENSION_FIELD); +} + tree gfc_conv_descriptor_rank (tree desc) { - tree tmp; - tree dtype; + tree field; + tree type; + + type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + + field = gfc_advance_chain (TYPE_FIELDS (type), RANK_FIELD); + gcc_assert (field != NULL_TREE + && TREE_CODE (TREE_TYPE (field)) == INTEGER_TYPE); + + return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + desc, field, NULL_TREE); +} + + +void +gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, int rank) +{ + tree field = gfc_conv_descriptor_rank (desc); + gfc_add_modify (block, field, build_int_cst (TREE_TYPE (field), rank)); +} + + +void +gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc) +{ + tree field; + tree type; + + type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + + field = gfc_advance_chain (TYPE_FIELDS (type), VERSION_FIELD); + gcc_assert (field != NULL_TREE && TREE_TYPE (field) == integer_type_node); + + field = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + desc, field, NULL_TREE); + gfc_add_modify (block, field, build_int_cst (integer_type_node, 1)); +} + + +void +gfc_conv_descriptor_attr_set (stmtblock_t *block, tree desc, int attr) +{ + tree field; + tree type; + + type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + + field = gfc_advance_chain (TYPE_FIELDS (type), ATTR_FIELD); + gcc_assert (field != NULL_TREE + && TREE_CODE (TREE_TYPE (field)) == INTEGER_TYPE); - 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); + field = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + desc, field, NULL_TREE); + gfc_add_modify (block, field, build_int_cst (TREE_TYPE (field), attr)); } @@ -267,7 +367,7 @@ gfc_get_descriptor_dimension (tree desc) type = TREE_TYPE (desc); gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD); + field = gfc_dimension_field_from_base_field (TYPE_FIELDS (type)); gcc_assert (field != NULL_TREE && TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE); @@ -309,15 +409,58 @@ gfc_conv_descriptor_token (tree desc) } +tree +gfc_conv_descriptor_stride_get (tree desc, tree dim) +{ + tree tmp, size, cond; + tree type = TREE_TYPE (desc); + + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + if (integer_zerop (dim) + && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE + ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT + ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT + ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)) + return gfc_index_one_node; + + tmp = gfc_get_element_type (type); + + size = gfc_conv_descriptor_elem_len_get (desc); + + size = fold_convert (gfc_array_index_type, size); + tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR, gfc_array_index_type, + gfc_conv_descriptor_sm_get (desc, dim), size); + cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, size, + gfc_index_zero_node); + tmp = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond, + gfc_index_zero_node, tmp); + return tmp; +} + + +void +gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, + tree dim, tree value) +{ + tree tmp; + tmp = gfc_get_element_type (TREE_TYPE (desc)); + tmp = gfc_conv_descriptor_elem_len_get (desc); + + tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + fold_convert (gfc_array_index_type, value), + fold_convert (gfc_array_index_type, tmp)); + gfc_conv_descriptor_sm_set (block, desc, dim, tmp); +} + static tree -gfc_conv_descriptor_stride (tree desc, tree dim) +gfc_conv_descriptor_sm (tree desc, tree dim) { tree tmp; tree field; tmp = gfc_conv_descriptor_dimension (desc, dim); field = TYPE_FIELDS (TREE_TYPE (tmp)); - field = gfc_advance_chain (field, STRIDE_SUBFIELD); + field = gfc_advance_chain (field, SM_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), @@ -326,37 +469,27 @@ gfc_conv_descriptor_stride (tree desc, tree dim) } tree -gfc_conv_descriptor_stride_get (tree desc, tree dim) +gfc_conv_descriptor_sm_get (tree desc, tree dim) { - tree type = TREE_TYPE (desc); - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - if (integer_zerop (dim) - && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE - ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT - ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT - ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)) - return gfc_index_one_node; - - return gfc_conv_descriptor_stride (desc, dim); + return gfc_conv_descriptor_sm (desc, dim); } void -gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, +gfc_conv_descriptor_sm_set (stmtblock_t *block, tree desc, tree dim, tree value) { - tree t = gfc_conv_descriptor_stride (desc, dim); + tree t = gfc_conv_descriptor_sm (desc, dim); gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)); } static tree -gfc_conv_descriptor_lbound (tree desc, tree dim) +gfc_conv_descriptor_extent (tree desc, tree dim) { tree tmp; tree field; - tmp = gfc_conv_descriptor_dimension (desc, dim); field = TYPE_FIELDS (TREE_TYPE (tmp)); - field = gfc_advance_chain (field, LBOUND_SUBFIELD); + field = gfc_advance_chain (field, EXTENT_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), @@ -365,28 +498,29 @@ gfc_conv_descriptor_lbound (tree desc, tree dim) } tree -gfc_conv_descriptor_lbound_get (tree desc, tree dim) +gfc_conv_descriptor_extent_get (tree desc, tree dim) { - return gfc_conv_descriptor_lbound (desc, dim); + return gfc_conv_descriptor_extent (desc, dim); } void -gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, +gfc_conv_descriptor_extent_set (stmtblock_t *block, tree desc, tree dim, tree value) { - tree t = gfc_conv_descriptor_lbound (desc, dim); + tree t = gfc_conv_descriptor_extent (desc, dim); gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)); } + static tree -gfc_conv_descriptor_ubound (tree desc, tree dim) +gfc_conv_descriptor_lbound (tree desc, tree dim) { tree tmp; tree field; tmp = gfc_conv_descriptor_dimension (desc, dim); field = TYPE_FIELDS (TREE_TYPE (tmp)); - field = gfc_advance_chain (field, UBOUND_SUBFIELD); + field = gfc_advance_chain (field, LBOUND_SUBFIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), @@ -395,35 +529,94 @@ gfc_conv_descriptor_ubound (tree desc, tree dim) } tree +gfc_conv_descriptor_lbound_get (tree desc, tree dim) +{ + return gfc_conv_descriptor_lbound (desc, dim); +} + +void +gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, + tree dim, tree value) +{ + tree t = gfc_conv_descriptor_lbound (desc, dim); + gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)); +} + +tree gfc_conv_descriptor_ubound_get (tree desc, tree dim) { - return gfc_conv_descriptor_ubound (desc, dim); + tree lb = gfc_conv_descriptor_lbound (desc, dim); + tree tmp = gfc_conv_descriptor_extent_get (desc, dim); + tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + fold_convert (gfc_array_index_type, lb), + fold_convert (gfc_array_index_type, tmp)); + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node); + return tmp; } void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree dim, tree value) { - tree t = gfc_conv_descriptor_ubound (desc, dim); - gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)); + tree tmp; + tmp = gfc_conv_descriptor_lbound (desc, dim); + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + fold_convert (gfc_array_index_type, value), + fold_convert (gfc_array_index_type, tmp)); + tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node); + gfc_conv_descriptor_extent_set (block, desc, dim, tmp); } /* Build a null array descriptor constructor. */ tree -gfc_build_null_descriptor (tree type) +gfc_build_null_descriptor (tree desc_type, int rank, int attr, + gfc_typespec *ts) { tree field; tree tmp; + tree elem_len; + vec<constructor_elt, va_gc> *init = NULL; - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (desc_type)); gcc_assert (DATA_FIELD == 0); - field = TYPE_FIELDS (type); /* Set a NULL data pointer. */ - tmp = build_constructor_single (type, field, null_pointer_node); + field = TYPE_FIELDS (desc_type); + CONSTRUCTOR_APPEND_ELT (init, field, null_pointer_node); + + /* Set elem_len. */ + tmp = gfc_advance_chain (field, ELEM_LEN_FIELD); + if (ts->deferred) + elem_len = build_int_cst (integer_type_node, 0); + else + elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (desc_type)); + CONSTRUCTOR_APPEND_ELT (init, tmp, elem_len); + + /* Set version to 1. */ + tmp = gfc_advance_chain (field, VERSION_FIELD); + CONSTRUCTOR_APPEND_ELT (init, tmp, + build_int_cst (integer_type_node, 1)); + + /* Set rank. */ + tmp = gfc_advance_chain (field, RANK_FIELD); + CONSTRUCTOR_APPEND_ELT (init, tmp, + build_int_cst (TREE_TYPE (tmp), rank)); + + /* Set attribute (allocatable, pointer, other). */ + tmp = gfc_advance_chain (field, ATTR_FIELD); + CONSTRUCTOR_APPEND_ELT (init, tmp, + build_int_cst (TREE_TYPE (tmp), attr)); + + /* Set type. */ + tmp = gfc_advance_chain (field, DTYPE_FIELD); + CONSTRUCTOR_APPEND_ELT (init, tmp, gfc_get_dtype (ts)); + + /* All other fields are set during allocate/pointer association. */ + tmp = build_constructor (desc_type, init); TREE_CONSTANT (tmp) = 1; - /* All other fields are ignored. */ return tmp; } @@ -436,32 +629,26 @@ void gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, int dim, tree new_lbound) { - tree offs, ubound, lbound, stride; + tree offs, lbound, stride; tree diff, offs_diff; new_lbound = fold_convert (gfc_array_index_type, new_lbound); offs = gfc_conv_descriptor_offset_get (desc); lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]); - ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]); stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]); /* Get difference (new - old) by which to shift stuff. */ diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, new_lbound, lbound); - /* Shift ubound and offset accordingly. This has to be done before - updating the lbound, as they depend on the lbound expression! */ - ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - ubound, diff); - gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound); offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, diff, stride); offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, offs, offs_diff); gfc_conv_descriptor_offset_set (block, desc, offs); - /* Finally set lbound to value we want. */ + /* Set lbound to value we want. */ gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound); } @@ -469,13 +656,19 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, /* Cleanup those #defines. */ #undef DATA_FIELD +#undef ELEM_LEN_FIELD +#undef VERSION_FIELD +#undef RANK_FIELD #undef OFFSET_FIELD #undef DTYPE_FIELD +#undef ATTR_FIELD #undef DIMENSION_FIELD #undef CAF_TOKEN_FIELD #undef STRIDE_SUBFIELD #undef LBOUND_SUBFIELD #undef UBOUND_SUBFIELD +#undef SM_SUBFIELD +#undef EXTENT_SUBFIELD /* Mark a SS chain as used. Flags specifies in which loops the SS is used. @@ -726,11 +919,25 @@ void gfc_trans_static_array_pointer (gfc_symbol * sym) { tree type; + int attr; gcc_assert (TREE_STATIC (sym->backend_decl)); - /* Just zero the data member. */ + + if (sym->attr.pointer) + attr = GFC_ATTRIBUTE_POINTER; + else if (sym->attr.allocatable) + attr = GFC_ATTRIBUTE_ALLOCATABLE; + else + gcc_unreachable (); + type = TREE_TYPE (sym->backend_decl); - DECL_INITIAL (sym->backend_decl) = gfc_build_null_descriptor (type); + DECL_INITIAL (sym->backend_decl) + = gfc_build_null_descriptor (type, sym->as->rank, attr, &sym->ts); + + if (sym->ts.type == BT_CHARACTER && sym->ts.deferred + && sym->ts.u.cl->backend_decl) + DECL_INITIAL (sym->ts.u.cl->backend_decl) = + build_int_cst (gfc_charlen_type_node, 0); } @@ -1001,7 +1208,8 @@ get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim) tree gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, tree eltype, tree initial, bool dynamic, - bool dealloc, bool callee_alloc, locus * where) + bool dealloc, bool callee_alloc, + gfc_typespec *ts, tree strlen, locus * where) { gfc_loopinfo *loop; gfc_ss *s; @@ -1011,6 +1219,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, tree desc; tree tmp; tree size; + tree elem_len; tree nelem; tree cond; tree or_expr; @@ -1092,7 +1301,21 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, GFC_DECL_PACKED_ARRAY (desc) = 1; info->descriptor = desc; - size = gfc_index_one_node; + + /* Fill in the elem_len, version, rank, dtype and attribute. */ + + if (class_expr != NULL_TREE) + elem_len = gfc_class_vtab_size_get (class_expr); + else if (ts->type == BT_CHARACTER && strlen) + elem_len = size_of_string_in_bytes (ts->kind, strlen); + else if (ts->type != BT_CHARACTER) + elem_len = size_in_bytes (gfc_typenode_for_spec (ts)); + else + elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + + gfc_conv_descriptor_elem_len_set (pre, desc, elem_len); + gfc_conv_descriptor_version_set (pre, desc); + gfc_conv_descriptor_rank_set (pre, desc, total_dim); /* Emit a DECL_EXPR for the variable sized array type in GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type @@ -1106,23 +1329,26 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, /* Fill in the array dtype. */ tmp = gfc_conv_descriptor_dtype (desc); - gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); + gfc_add_modify (pre, tmp, gfc_get_dtype (ts)); + gfc_conv_descriptor_attr_set (pre, desc, GFC_ATTRIBUTE_ALLOCATABLE); /* Fill in the bounds and stride. This is a packed array, so: - size = 1; + size = elem_len; for (n = 0; n < rank; n++) { - stride[n] = size - delta = ubound[n] + 1 - lbound[n]; + sm[n] = size + delta = extent[n]; size = size * delta; } - size = size * sizeof(element); */ or_expr = NULL_TREE; + elem_len = fold_convert (gfc_array_index_type, elem_len); + size = elem_len; + /* If there is at least one null loop->to[n], it is a callee allocated array. */ for (n = 0; n < total_dim; n++) @@ -1142,8 +1368,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, of the descriptor fields. */ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]), - gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim])); + gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[dim]), + gfc_index_one_node); s->loop->to[n] = tmp; } else @@ -1151,17 +1377,17 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, for (n = 0; n < total_dim; n++) { /* Store the stride and bound components in the descriptor. */ - gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); + gfc_conv_descriptor_sm_set (pre, desc, gfc_rank_cst[n], size); gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n], gfc_index_zero_node); - gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]); - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, to[n], gfc_index_one_node); + gfc_conv_descriptor_extent_set (pre, desc, gfc_rank_cst[n], tmp); + /* Check whether the size for this dimension is negative. */ cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp, gfc_index_zero_node); @@ -1180,27 +1406,21 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, } /* Get the size of the array. */ - if (size && !callee_alloc) + if (size != NULL_TREE && !callee_alloc) { - tree elemsize; /* If or_expr is true, then the extent in at least one dimension is zero and the size is set to zero. */ size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, or_expr, gfc_index_zero_node, size); - - nelem = size; - if (class_expr == NULL_TREE) - elemsize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - else - elemsize = gfc_class_vtab_size_get (class_expr); - - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, elemsize); + nelem = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_array_index_type, size, elem_len); } else { - nelem = size; + nelem = (size == NULL_TREE) + ? NULL_TREE + : fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_array_index_type, size, elem_len); size = NULL_TREE; } @@ -1245,27 +1465,25 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra) tree arg0, arg1; tree tmp; tree size; - tree ubound; + tree extent; if (integer_zerop (extra)) return; - ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]); + extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[0]); - /* Add EXTRA to the upper bound. */ - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - ubound, extra); - gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp); + /* Add EXTRA to the extent. */ + extent = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + extent, extra); + gfc_conv_descriptor_extent_set (pblock, desc, gfc_rank_cst[0], extent); /* Get the value of the current data pointer. */ arg0 = gfc_conv_descriptor_data_get (desc); /* Calculate the new array size. */ size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - ubound, gfc_index_one_node); arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node, - fold_convert (size_type_node, tmp), + fold_convert (size_type_node, extent), fold_convert (size_type_node, size)); /* Call the realloc() function. */ @@ -1486,7 +1704,7 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock, /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); /* Make sure the constructed array has room for the new data. */ if (dynamic) @@ -2353,7 +2571,8 @@ trans_array_constructor (gfc_ss * ss, locus * where) } gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type, - NULL_TREE, dynamic, true, false, where); + NULL_TREE, dynamic, true, false, &expr->ts, + ss_info->string_length, where); desc = ss_info->data.array.descriptor; offset = gfc_index_zero_node; @@ -2443,8 +2662,8 @@ set_vector_loop_bounds (gfc_ss * ss) zero = gfc_rank_cst[0]; tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - gfc_conv_descriptor_ubound_get (desc, zero), - gfc_conv_descriptor_lbound_get (desc, zero)); + gfc_conv_descriptor_extent_get (desc, zero), + gfc_index_one_node); tmp = gfc_evaluate_now (tmp, &outer_loop->pre); loop->to[n] = tmp; } @@ -2773,6 +2992,32 @@ gfc_conv_array_offset (tree descriptor) } +/* Get an expression for the array stride multiplier. */ + +tree +gfc_conv_array_sm (tree descriptor, int dim) +{ + tree tmp; + tree type; + + type = TREE_TYPE (descriptor); + + /* For descriptorless arrays use the array size. */ + tmp = GFC_TYPE_ARRAY_STRIDE (type, dim); + if (tmp != NULL_TREE) + { + tree size = gfc_get_element_type (TREE_TYPE (descriptor)); + size = size_in_bytes (size); + size = fold_convert (gfc_array_index_type, size); + return fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, tmp, size); + } + + tmp = gfc_conv_descriptor_sm_get (descriptor, gfc_rank_cst[dim]); + return tmp; +} + + /* Get an expression for the array stride. */ tree @@ -2812,6 +3057,31 @@ gfc_conv_array_lbound (tree descriptor, int dim) } +/* Like gfc_conv_array_stride, but for the extent. */ + +tree +gfc_conv_array_extent (tree descriptor, int dim) +{ + tree tmp; + tree type; + + type = TREE_TYPE (descriptor); + + tmp = GFC_TYPE_ARRAY_LBOUND (type, dim); + if (tmp != NULL_TREE) + { + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + GFC_TYPE_ARRAY_UBOUND (type, dim), tmp); + return fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tmp, gfc_index_one_node); + } + + tmp = gfc_conv_descriptor_extent_get (descriptor, gfc_rank_cst[dim]); + return tmp; +} + + /* Like gfc_conv_array_stride, but for the upper bound. */ tree @@ -3948,6 +4218,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_ISYM_UBOUND: case GFC_ISYM_LCOBOUND: case GFC_ISYM_UCOBOUND: + case GFC_ISYM_SHAPE: case GFC_ISYM_THIS_IMAGE: loop->dimen = ss->dimen; goto done; @@ -3999,11 +4270,13 @@ done: /* Fall through to supply start and stride. */ case GFC_ISYM_LBOUND: case GFC_ISYM_UBOUND: + case GFC_ISYM_SHAPE: { gfc_expr *arg; /* This is the variant without DIM=... */ - gcc_assert (expr->value.function.actual->next->expr == NULL); + gcc_assert (expr->value.function.actual->next->expr == NULL + || expr->value.function.isym->id == GFC_ISYM_SHAPE); arg = expr->value.function.actual->expr; if (arg->rank == -1) @@ -4788,10 +5061,12 @@ set_loop_bounds (gfc_loopinfo *loop) { gfc_expr *expr = loopspec[n]->info->expr; - /* The {l,u}bound of an assumed rank. */ + /* The {l,u}bound and shape of an assumed rank. */ gcc_assert ((expr->value.function.isym->id == GFC_ISYM_LBOUND - || expr->value.function.isym->id == GFC_ISYM_UBOUND) - && expr->value.function.actual->next->expr == NULL + || expr->value.function.isym->id == GFC_ISYM_UBOUND + || expr->value.function.isym->id == GFC_ISYM_SHAPE) + && (expr->value.function.actual->next->expr == NULL + || expr->value.function.isym->id == GFC_ISYM_SHAPE) && expr->value.function.actual->expr->rank == -1); loop->to[n] = info->end[dim]; @@ -4839,7 +5114,7 @@ set_loop_bounds (gfc_loopinfo *loop) moved outside the loop. */ void -gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) +gfc_conv_loop_setup (gfc_loopinfo *loop, locus *where, gfc_typespec *ts) { gfc_ss *tmp_ss; tree tmp; @@ -4875,7 +5150,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (tmp_ss->dimen != 0); gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp, - NULL_TREE, false, true, false, where); + NULL_TREE, false, true, false, ts, + tmp_ss_info->string_length, where); } /* For array parameters we don't have loop variables, so don't calculate the @@ -4989,14 +5265,9 @@ gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim) for (dim = from_dim; dim < to_dim; ++dim) { - tree lbound; - tree ubound; tree extent; - lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]); - ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]); - - extent = gfc_conv_array_extent_dim (lbound, ubound, NULL); + extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[dim]); res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, res, extent); } @@ -5083,20 +5354,41 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, stride = gfc_index_one_node; offset = gfc_index_zero_node; - /* Set the dtype. */ - if (expr->ts.type == BT_CHARACTER && expr->ts.deferred - && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL) + /* Set the rank and dtype. */ + gfc_conv_descriptor_rank_set (descriptor_block, descriptor, rank); + tmp = gfc_conv_descriptor_dtype (descriptor); + gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (&expr->ts)); + + if (expr3_elem_size != NULL_TREE) + tmp = expr3_elem_size; + else if (expr3 != NULL) { - type = gfc_typenode_for_spec (&expr->ts); - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (descriptor_block, tmp, - gfc_get_dtype_rank_type (rank, type)); + if (expr3->ts.type == BT_CLASS) + { + gfc_se se_sz; + gfc_expr *sz = gfc_copy_expr (expr3); + gfc_add_vptr_component (sz); + gfc_add_size_component (sz); + gfc_init_se (&se_sz, NULL); + gfc_conv_expr (&se_sz, sz); + gfc_free_expr (sz); + tmp = se_sz.expr; + } + else + { + tmp = gfc_typenode_for_spec (&expr3->ts); + tmp = TYPE_SIZE_UNIT (tmp); + } } + else if (expr->ts.type != BT_UNKNOWN && expr->ts.type != BT_CHARACTER) + /* FIXME: Properly handle characters. See PR 57456. */ + tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr->ts)); else - { - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type)); - } + tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + + /* Convert to size_t. */ + element_size = fold_convert (size_type_node, tmp); + gfc_conv_descriptor_elem_len_set (descriptor_block, descriptor, element_size); or_expr = boolean_false_node; @@ -5150,7 +5442,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, offset, tmp); - /* Set upper bound. */ + /* Set extent. */ gfc_init_se (&se, NULL); if (expr3_desc != NULL_TREE) { @@ -5183,10 +5475,20 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, if (ubound->expr_type == EXPR_FUNCTION) se.expr = gfc_evaluate_now (se.expr, pblock); } + gfc_conv_descriptor_ubound_set (descriptor_block, descriptor, gfc_rank_cst[n], se.expr); conv_ubound = se.expr; + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + conv_ubound, conv_lbound); + tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node); + tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type, + tmp, gfc_index_zero_node); + gfc_conv_descriptor_extent_set (descriptor_block, descriptor, + gfc_rank_cst[n], tmp); + /* Store the stride. */ gfc_conv_descriptor_stride_set (descriptor_block, descriptor, gfc_rank_cst[n], stride); @@ -5264,36 +5566,6 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, } } - /* The stride is the number of elements in the array, so multiply by the - size of an element to get the total size. Obviously, if there is a - SOURCE expression (expr3) we must use its element size. */ - if (expr3_elem_size != NULL_TREE) - tmp = expr3_elem_size; - else if (expr3 != NULL) - { - if (expr3->ts.type == BT_CLASS) - { - gfc_se se_sz; - gfc_expr *sz = gfc_copy_expr (expr3); - gfc_add_vptr_component (sz); - gfc_add_size_component (sz); - gfc_init_se (&se_sz, NULL); - gfc_conv_expr (&se_sz, sz); - gfc_free_expr (sz); - tmp = se_sz.expr; - } - else - { - tmp = gfc_typenode_for_spec (&expr3->ts); - tmp = TYPE_SIZE_UNIT (tmp); - } - } - else - tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type)); - - /* Convert to size_t. */ - element_size = fold_convert (size_type_node, tmp); - if (rank == 0) return element_size; @@ -5482,8 +5754,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, overflow = integer_zero_node; gfc_init_block (&set_descriptor_block); - size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank - : ref->u.ar.as->rank, + size = gfc_array_init_size (se->expr, + alloc_w_e3_arr_spec ? expr->rank + : ref->u.ar.as->rank, coarray ? ref->u.ar.as->corank : 0, &offset, lower, upper, &se->pre, &set_descriptor_block, &overflow, @@ -5741,7 +6014,8 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr) break; case EXPR_NULL: - return gfc_build_null_descriptor (type); + return gfc_build_null_descriptor (type, 1, GFC_ATTRIBUTE_OTHER, + &expr->ts); default: gcc_unreachable (); @@ -6735,11 +7009,15 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) int n; tree tmp; tree desc; + tree elem_type; stmtblock_t block; tree start; tree offset; + tree elem_len; int full; bool subref_array_target = false; + bool assumed_size = false; + bool abstract_class = false; gfc_expr *arg, *ss_expr; if (se->want_coarray) @@ -6786,6 +7064,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) if (se->force_tmp) need_tmp = 1; + if (info->ref->u.ar.as->type == AS_ASSUMED_SIZE) + assumed_size = true; + if (need_tmp) full = 0; else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) @@ -6938,7 +7219,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_add_ss_to_loop (&loop, loop.temp_ss); } - gfc_conv_loop_setup (&loop, & expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); if (need_tmp) { @@ -7060,6 +7341,20 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) } desc = info->descriptor; + + /* Classes with an abstract declared type present particular problems + because they mess up the 'desc' totally and they have to be detected + to provide the dynamic type elem_len. + TODO extend this to all class expressions. */ + abstract_class = gfc_expr_attr (expr).abstract + && expr->expr_type == EXPR_VARIABLE + && expr->symtree->n.sym->ts.type == BT_CLASS; + + if (abstract_class) + elem_type = gfc_typenode_for_spec(&CLASS_DATA (expr->symtree->n.sym)->ts); + else + elem_type = gfc_typenode_for_spec(&expr->ts); + if (se->direct_byref && !se->byref_noassign) { /* For pointer assignments we fill in the destination. */ @@ -7069,8 +7364,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) else { /* Otherwise make a new one. */ - parmtype = gfc_get_element_type (TREE_TYPE (desc)); - parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, codim, + parmtype = gfc_get_array_type_bounds (elem_type, + loop.dimen, codim, loop.from, loop.to, 0, GFC_ARRAY_UNKNOWN, false); parm = gfc_create_var (parmtype, "parm"); @@ -7087,9 +7382,34 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) We don't have to worry about numeric overflows when calculating the offsets because all elements are within the array data. */ - /* Set the dtype. */ + /* Set elem_len, version, rank, dtype and attribute. */ + if (expr->ts.type == BT_CHARACTER && !is_subref_array (expr)) + elem_len = size_of_string_in_bytes (expr->ts.kind, se->string_length); + else if (abstract_class) + { + tmp = expr->symtree->n.sym->backend_decl; + if (DECL_LANG_SPECIFIC (tmp) && GFC_DECL_SAVED_DESCRIPTOR (tmp)) + tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp); + + tmp = gfc_get_vptr_from_expr (tmp); + if (tmp != NULL_TREE) + elem_len = gfc_vptr_size_get (tmp); + else + elem_len = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); + } + else + /* TODO Set this to the size of elem_type rather than the size of the + descriptor elements. */ + elem_len = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); + + elem_len = fold_convert (gfc_array_index_type, elem_len); + + gfc_conv_descriptor_elem_len_set (&loop.pre, parm, elem_len); + gfc_conv_descriptor_version_set (&loop.pre, parm); + gfc_conv_descriptor_rank_set (&loop.pre, parm, loop.dimen); tmp = gfc_conv_descriptor_dtype (parm); - gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype)); + gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (&expr->ts)); + gfc_conv_descriptor_attr_set (&loop.pre, parm, GFC_ATTRIBUTE_OTHER); /* Set offset for assignments to pointer only to zero if it is not the full array. */ @@ -7156,9 +7476,22 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_conv_descriptor_lbound_set (&loop.pre, parm, gfc_rank_cst[dim], from); - /* Set the new upper bound. */ - gfc_conv_descriptor_ubound_set (&loop.pre, parm, - gfc_rank_cst[dim], to); + /* Set the new extent. */ + if (assumed_size && dim == ndim - 1) + tmp = build_int_cst (gfc_array_index_type, -1); + else + { + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, to, from); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tmp, + gfc_index_one_node); + tmp = fold_build2_loc (input_location, MAX_EXPR, + gfc_array_index_type, tmp, + gfc_index_zero_node); + } + gfc_conv_descriptor_extent_set (&loop.pre, parm, + gfc_rank_cst[dim], tmp); /* Multiply the stride by the section stride to get the total stride. */ @@ -7196,9 +7529,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) TREE_TYPE (base), tmp, base); } - /* Store the new stride. */ - gfc_conv_descriptor_stride_set (&loop.pre, parm, - gfc_rank_cst[dim], stride); + /* Store the new stride measure. */ + tmp = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride, elem_len); + gfc_conv_descriptor_sm_set (&loop.pre, parm, + gfc_rank_cst[dim], tmp); } for (n = loop.dimen; n < loop.dimen + codim; n++) @@ -7256,6 +7591,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) it to zero here. */ gfc_conv_descriptor_offset_set (&loop.pre, parm, gfc_index_zero_node); } + desc = parm; } @@ -7301,13 +7637,7 @@ array_parameter_size (tree desc, gfc_expr *expr, tree *size) gfc_build_addr_expr (NULL, desc)); else { - tree ubound = gfc_conv_descriptor_ubound_get (desc, gfc_index_zero_node); - tree lbound = gfc_conv_descriptor_lbound_get (desc, gfc_index_zero_node); - - *size = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, ubound, lbound); - *size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - *size, gfc_index_one_node); + *size = gfc_conv_descriptor_extent_get (desc, gfc_index_zero_node); *size = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type, *size, gfc_index_zero_node); } @@ -7580,13 +7910,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, tree old_desc = tmp; tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc"); - old_field = gfc_conv_descriptor_dtype (old_desc); - new_field = gfc_conv_descriptor_dtype (new_desc); - gfc_add_modify (&se->pre, new_field, old_field); - - old_field = gfc_conv_descriptor_offset (old_desc); - new_field = gfc_conv_descriptor_offset (new_desc); - gfc_add_modify (&se->pre, new_field, old_field); + gfc_add_modify (&se->pre, new_desc, old_desc); for (int i = 0; i < expr->rank; i++) { @@ -7728,15 +8052,10 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int rank) tree nelems; tree tmp; idx = gfc_rank_cst[rank - 1]; - nelems = gfc_conv_descriptor_ubound_get (decl, idx); - tmp = gfc_conv_descriptor_lbound_get (decl, idx); - tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - nelems, tmp); - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - tmp, gfc_index_one_node); - tmp = gfc_evaluate_now (tmp, block); + nelems = gfc_conv_descriptor_extent_get (decl, idx); + nelems = gfc_evaluate_now (nelems, block); - nelems = gfc_conv_descriptor_stride_get (decl, idx); + tmp = gfc_conv_descriptor_stride_get (decl, idx); tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, nelems, tmp); return gfc_evaluate_now (tmp, block); @@ -8146,14 +8465,37 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, break; case NULLIFY_ALLOC_COMP: - if (c->attr.pointer || c->attr.proc_pointer) + /* We also need to set the version, attribute etc. fields of + pointers to arrays. */ + cmp_has_alloc_comps = cmp_has_alloc_comps + || ((c->ts.type == BT_DERIVED + || c->ts.type == BT_CLASS) + && c->ts.u.derived->attr.pointer_comp); + + if (c->attr.proc_pointer) continue; - else if (c->attr.allocatable - && (c->attr.dimension|| c->attr.codimension)) + if (c->ts.type != BT_CLASS && (c->attr.allocatable || c->attr.pointer) + && (c->attr.dimension || c->attr.codimension)) { + tree type; + comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); + if (!UNLIMITED_POLY (c)) + { + type = gfc_get_element_type (TREE_TYPE (comp)); + gfc_conv_descriptor_elem_len_set (&fnblock, comp, + TYPE_SIZE_UNIT (type)); + } + gfc_conv_descriptor_version_set (&fnblock, comp); + gfc_conv_descriptor_rank_set (&fnblock, comp, c->as->rank); + gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp), + gfc_get_dtype (&c->ts)); + gfc_conv_descriptor_attr_set (&fnblock, comp, + c->attr.allocatable + ? GFC_ATTRIBUTE_ALLOCATABLE + : GFC_ATTRIBUTE_POINTER); } else if (c->attr.allocatable) { @@ -8175,7 +8517,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_add_expr_to_block (&fnblock, tmp); } } - else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) + else if (c->ts.type == BT_CLASS + && (CLASS_DATA (c)->attr.allocatable + || CLASS_DATA (c)->attr.dimension + || (CLASS_DATA (c)->attr.codimension + && flag_coarray != GFC_FCOARRAY_LIB))) { /* Allocatable CLASS components. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, @@ -8184,8 +8530,26 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tmp = CLASS_DATA (c)->backend_decl; comp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), comp, tmp, NULL_TREE); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) - gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); + if (GFC_DESCRIPTOR_TYPE_P(TREE_TYPE (comp))) + { + gfc_conv_descriptor_data_set (&fnblock, comp, + null_pointer_node); + if (!UNLIMITED_POLY (c)) + { + tree type = gfc_get_element_type (TREE_TYPE (comp)); + gfc_conv_descriptor_elem_len_set (&fnblock, comp, + TYPE_SIZE_UNIT (type)); + } + gfc_conv_descriptor_version_set (&fnblock, comp); + gfc_conv_descriptor_rank_set (&fnblock, comp, + CLASS_DATA (c)->as->rank); + gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp), + gfc_get_dtype (&c->ts)); + gfc_conv_descriptor_attr_set (&fnblock, comp, + c->attr.allocatable + ? GFC_ATTRIBUTE_ALLOCATABLE + : GFC_ATTRIBUTE_POINTER); + } else { tmp = fold_build2_loc (input_location, MODIFY_EXPR, @@ -8194,6 +8558,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_add_expr_to_block (&fnblock, tmp); } } + else if (c->attr.pointer) + continue; else if (cmp_has_alloc_comps) { comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, @@ -8447,7 +8813,7 @@ static tree get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size) { tree lbound; - tree ubound; + tree extent; tree stride; tree cond, cond1, cond3, cond4; tree tmp; @@ -8457,10 +8823,10 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size) { tmp = gfc_rank_cst[dim]; lbound = gfc_conv_descriptor_lbound_get (desc, tmp); - ubound = gfc_conv_descriptor_ubound_get (desc, tmp); + extent = gfc_conv_descriptor_extent_get (desc, tmp); stride = gfc_conv_descriptor_stride_get (desc, tmp); - cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, - ubound, lbound); + cond1 = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + extent, gfc_index_zero_node); cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, stride, gfc_index_zero_node); cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR, @@ -8641,13 +9007,14 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tree alloc_expr; tree size1; tree size2; + tree elem_len; tree array1; tree cond_null; tree cond; tree tmp; tree tmp2; tree lbound; - tree ubound; + tree extent; tree desc; tree old_desc; tree desc2; @@ -8655,7 +9022,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tree jump_label1; tree jump_label2; tree neq_size; - tree lbd; int n; int dim; gfc_array_spec * as; @@ -8749,21 +9115,18 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, bounds and doing the reallocation....... */ for (n = 0; n < expr1->rank; n++) { + tree extent; /* Check the shape. */ - lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]); - ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]); + extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[n]); tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n]); tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - tmp, lbound); - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - tmp, ubound); + tmp, gfc_index_one_node); cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - tmp, gfc_index_zero_node); + tmp, extent); tmp = build3_v (COND_EXPR, cond, build1_v (GOTO_EXPR, jump_label1), build_empty_stmt (input_location)); @@ -8841,39 +9204,68 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, size1 = gfc_index_one_node; offset = gfc_index_zero_node; + /* Get the new lhs size in bytes. */ + if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) + { + if (expr2->ts.deferred) + { + if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) + tmp = expr2->ts.u.cl->backend_decl; + else + tmp = rss->info->string_length; + } + else + { + tmp = expr2->ts.u.cl->backend_decl; + if (!tmp && expr2->expr_type == EXPR_OP + && expr2->value.op.op == INTRINSIC_CONCAT) + { + tmp = concat_str_length (expr2); + expr2->ts.u.cl->backend_decl = gfc_evaluate_now (tmp, &fblock); + } + tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); + } + + if (expr1->ts.u.cl->backend_decl + && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) + gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); + else + gfc_add_modify (&fblock, lss->info->string_length, tmp); + } + else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) + { + tmp = TYPE_SIZE_UNIT (TREE_TYPE (gfc_typenode_for_spec (&expr1->ts))); + tmp = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, tmp, + expr1->ts.u.cl->backend_decl); + } + else + tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr1->ts)); + + elem_len = fold_convert (gfc_array_index_type, tmp); + + gfc_conv_descriptor_elem_len_set (&fblock, desc, elem_len); + for (n = 0; n < expr2->rank; n++) { + lbound = gfc_index_one_node; tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n]); - tmp = fold_build2_loc (input_location, PLUS_EXPR, + extent = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, tmp, gfc_index_one_node); - lbound = gfc_index_one_node; - ubound = tmp; - if (as) - { - lbd = get_std_lbound (expr2, desc2, n, - as->type == AS_ASSUMED_SIZE); - ubound = fold_build2_loc (input_location, - MINUS_EXPR, - gfc_array_index_type, - ubound, lbound); - ubound = fold_build2_loc (input_location, - PLUS_EXPR, - gfc_array_index_type, - ubound, lbd); - lbound = lbd; - } + lbound = get_std_lbound (expr2, desc2, n, + as->type == AS_ASSUMED_SIZE); gfc_conv_descriptor_lbound_set (&fblock, desc, gfc_rank_cst[n], lbound); - gfc_conv_descriptor_ubound_set (&fblock, desc, + gfc_conv_descriptor_extent_set (&fblock, desc, gfc_rank_cst[n], - ubound); + extent); gfc_conv_descriptor_stride_set (&fblock, desc, gfc_rank_cst[n], size1); @@ -8887,7 +9279,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, offset, tmp2); size1 = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - tmp, size1); + extent, size1); } /* Set the lhs descriptor and scalarizer offsets. For rank > 1, @@ -8912,47 +9304,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_modify (&fblock, linfo->delta[dim], tmp); } - /* Get the new lhs size in bytes. */ - if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) - { - if (expr2->ts.deferred) - { - if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL) - tmp = expr2->ts.u.cl->backend_decl; - else - tmp = rss->info->string_length; - } - else - { - tmp = expr2->ts.u.cl->backend_decl; - if (!tmp && expr2->expr_type == EXPR_OP - && expr2->value.op.op == INTRINSIC_CONCAT) - { - tmp = concat_str_length (expr2); - expr2->ts.u.cl->backend_decl = gfc_evaluate_now (tmp, &fblock); - } - tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp); - } - - if (expr1->ts.u.cl->backend_decl - && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL) - gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp); - else - gfc_add_modify (&fblock, lss->info->string_length, tmp); - } - else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl) - { - tmp = TYPE_SIZE_UNIT (TREE_TYPE (gfc_typenode_for_spec (&expr1->ts))); - tmp = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, tmp, - expr1->ts.u.cl->backend_decl); - } - else - tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr1->ts)); - tmp = fold_convert (gfc_array_index_type, tmp); size2 = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - tmp, size2); + elem_len, size2); size2 = fold_convert (size_type_node, size2); size2 = fold_build2_loc (input_location, MAX_EXPR, size_type_node, size2, size_one_node); @@ -8963,15 +9317,14 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) && expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { - tree type; + gfc_typespec *ts; tmp = gfc_conv_descriptor_dtype (desc); if (expr2->ts.u.cl->backend_decl) - type = gfc_typenode_for_spec (&expr2->ts); + ts = &expr2->ts; else - type = gfc_typenode_for_spec (&expr1->ts); + ts = &expr1->ts; - gfc_add_modify (&fblock, tmp, - gfc_get_dtype_rank_type (expr1->rank,type)); + gfc_add_modify (&fblock, tmp, gfc_get_dtype (ts)); } /* Realloc expression. Note that the scalarizer uses desc.data @@ -9016,6 +9369,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, 1, size2); gfc_conv_descriptor_data_set (&alloc_block, desc, tmp); + gfc_conv_descriptor_rank_set (&alloc_block, desc, expr1->rank); /* We already set the dtype in the case of deferred character length arrays. */ @@ -9023,7 +9377,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, && expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)) { tmp = gfc_conv_descriptor_dtype (desc); - gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc))); + gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (&expr1->ts)); } if ((expr1->ts.type == BT_DERIVED) @@ -9152,9 +9506,24 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) type = TREE_TYPE (descriptor); } - /* NULLIFY the data pointer, for non-saved allocatables. */ + /* NULLIFY the data pointer and set default values for the fields. */ + /* NULLIFY the data pointer and set default values for the fields, + for non-saved allocatables. */ if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save && sym->attr.allocatable) - gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node); + { + gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node); + gfc_conv_descriptor_elem_len_set (&init, descriptor, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + gfc_conv_descriptor_version_set (&init, descriptor); + gfc_conv_descriptor_rank_set (&init, descriptor, sym->as->rank); + tmp = gfc_conv_descriptor_dtype (descriptor); + gfc_add_modify (&init, tmp, gfc_get_dtype (&sym->ts)); + gcc_assert (sym->attr.allocatable || sym->attr.pointer); + gfc_conv_descriptor_attr_set (&init, descriptor, + sym->attr.allocatable + ? GFC_ATTRIBUTE_ALLOCATABLE + : GFC_ATTRIBUTE_POINTER); + } gfc_restore_backend_locus (&loc); gfc_init_block (&cleanup); diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index d0309b27831..1025b9f75eb 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -32,7 +32,8 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, /* Generate code to create a temporary array. */ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *, - tree, tree, bool, bool, bool, locus *); + tree, tree, bool, bool, bool, + gfc_typespec *, tree, locus *); /* Generate function entry code for allocation of compiler allocated array variables. */ @@ -120,13 +121,13 @@ void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *); /* Mark the end of the main loop body and the start of the copying loop. */ void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *); /* Initialize the scalarization loop parameters. */ -void gfc_conv_loop_setup (gfc_loopinfo *, locus *); +void gfc_conv_loop_setup (gfc_loopinfo *, locus *, gfc_typespec *ts); /* Set each array's delta. */ void gfc_set_delta (gfc_loopinfo *); /* Resolve array assignment dependencies. */ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); /* Build a null array descriptor constructor. */ -tree gfc_build_null_descriptor (tree); +tree gfc_build_null_descriptor (tree, int, int, gfc_typespec *); /* Get a single array element. */ void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *); @@ -148,8 +149,10 @@ tree gfc_conv_array_data (tree); tree gfc_conv_array_offset (tree); /* Return either an INT_CST or an expression for that part of the descriptor. */ tree gfc_conv_array_stride (tree, int); +tree gfc_conv_array_sm (tree, int); tree gfc_conv_array_lbound (tree, int); tree gfc_conv_array_ubound (tree, int); +tree gfc_conv_array_extent (tree, int); /* Set cobounds of an array. */ void gfc_trans_array_cobounds (tree, stmtblock_t *, const gfc_symbol *); @@ -164,13 +167,25 @@ tree gfc_get_descriptor_dimension (tree); tree gfc_conv_descriptor_stride_get (tree, tree); tree gfc_conv_descriptor_lbound_get (tree, tree); tree gfc_conv_descriptor_ubound_get (tree, tree); +tree gfc_conv_descriptor_sm_get (tree, tree); +tree gfc_conv_descriptor_extent_get (tree, tree); tree gfc_conv_descriptor_token (tree); +tree gfc_conv_descriptor_elem_len_get (tree); +void gfc_conv_descriptor_elem_len_set (stmtblock_t *, tree, tree); +void gfc_conv_descriptor_rank_set (stmtblock_t *, tree, int); +void gfc_conv_descriptor_version_set (stmtblock_t *, tree); +void gfc_conv_descriptor_attr_set (stmtblock_t *, tree, int); + +tree gfc_data_field_from_base_field (tree); +tree gfc_dimension_field_from_base_field (tree); void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree); void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree); void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree); +void gfc_conv_descriptor_sm_set (stmtblock_t *, tree, tree, tree); +void gfc_conv_descriptor_extent_set (stmtblock_t *, tree, tree, tree); /* Shift lower bound of descriptor, updating ubound and offset. */ void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 20ec69eb570..2e7517871e4 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -676,7 +676,8 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) TREE_TYPE (s->field), s->sym->attr.dimension, s->sym->attr.pointer - || s->sym->attr.allocatable, false); + || s->sym->attr.allocatable, false, + s->sym->as ? s->sym->as->rank : 0); CONSTRUCTOR_APPEND_ELT (v, s->field, tmp); } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5bae8ca2b19..332cc725577 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1752,7 +1752,8 @@ gfc_get_symbol_decl (gfc_symbol * sym) && sym->attr.allocatable), sym->attr.pointer || sym->attr.allocatable || sym->ts.type == BT_CLASS, - sym->attr.proc_pointer); + sym->attr.proc_pointer, + sym->as ? sym->as->rank : 0); } if (!TREE_STATIC (decl) @@ -1862,7 +1863,8 @@ get_proc_pointer_decl (gfc_symbol *sym) DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts, TREE_TYPE (decl), sym->attr.dimension, - false, true); + false, true, + sym->as ? sym->as->rank : 0); } /* Handle threadprivate procedure pointers. */ @@ -4188,9 +4190,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) NULL_TREE); } - if (sym->ts.type == BT_CLASS + if (sym->ts.type == BT_CLASS && !sym->attr.dummy && (sym->attr.save || flag_max_stack_var_size == 0) - && CLASS_DATA (sym)->attr.allocatable) + && (CLASS_DATA (sym)->attr.allocatable + || CLASS_DATA (sym)->attr.dimension + || (CLASS_DATA (sym)->attr.codimension + && flag_coarray != GFC_FCOARRAY_LIB))) { tree vptr; @@ -4208,8 +4213,19 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) || (CLASS_DATA (sym)->attr.codimension && flag_coarray != GFC_FCOARRAY_LIB)) { + int attr; + + if (CLASS_DATA (sym)->attr.class_pointer) + attr = GFC_ATTRIBUTE_POINTER; + else if (CLASS_DATA (sym)->attr.allocatable) + attr = GFC_ATTRIBUTE_ALLOCATABLE; + else + gcc_unreachable (); + tmp = gfc_class_data_get (sym->backend_decl); - tmp = gfc_build_null_descriptor (TREE_TYPE (tmp)); + tmp = gfc_build_null_descriptor (TREE_TYPE (tmp), + CLASS_DATA (sym)->as->rank, + attr, &sym->ts); } else tmp = null_pointer_node; @@ -4350,6 +4366,24 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_set_backend_locus (&sym->declared_at); gfc_start_block (&init); + if (!sym->attr.dummy && sym->ts.type == BT_CLASS + && CLASS_DATA (sym)->as) + { + tree cdesc = gfc_class_data_get (sym->backend_decl); + tree type = TREE_TYPE (CLASS_DATA (sym)->backend_decl); + gfc_conv_descriptor_elem_len_set (&init, cdesc, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + gfc_conv_descriptor_version_set (&init, cdesc); + gfc_conv_descriptor_rank_set (&init, cdesc, + CLASS_DATA (sym)->as->rank); + tmp = gfc_conv_descriptor_dtype (cdesc); + gfc_add_modify (&init, tmp, gfc_get_dtype (&sym->ts)); + gfc_conv_descriptor_attr_set (&init, cdesc, + CLASS_DATA (sym)->attr.allocatable + ? GFC_ATTRIBUTE_ALLOCATABLE + : GFC_ATTRIBUTE_POINTER); + } + if (!sym->attr.pointer) { /* Nullify and automatic deallocation of allocatable @@ -4994,7 +5028,8 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym) DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts, TREE_TYPE (decl), sym->attr.dimension, - false, false); + false, false, + sym->as ? sym->as->rank : 0); debug_hooks->early_global_decl (decl); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 19239fb51f2..f0cdfca77c1 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -64,19 +64,40 @@ get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr) } tree -gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) +gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr, + gfc_typespec *ts) { - tree desc, type; + tree desc, type, dtype, elem_len; + int desc_attr; - type = get_scalar_to_descriptor_type (scalar, attr); - desc = gfc_create_var (type, "desc"); + dtype = get_scalar_to_descriptor_type (scalar, attr); + desc = gfc_create_var (dtype, "desc"); DECL_ARTIFICIAL (desc) = 1; if (!POINTER_TYPE_P (TREE_TYPE (scalar))) scalar = gfc_build_addr_expr (NULL_TREE, scalar); + + type = gfc_typenode_for_spec (ts); + + if (type == NULL_TREE) + elem_len = build_int_cst (size_type_node, 0); + else + elem_len = TYPE_SIZE_UNIT (type); + gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc), - gfc_get_dtype (type)); + gfc_get_dtype (ts)); gfc_conv_descriptor_data_set (&se->pre, desc, scalar); + gfc_conv_descriptor_elem_len_set (&se->pre, desc, elem_len); + gfc_conv_descriptor_version_set (&se->pre, desc); + gfc_conv_descriptor_rank_set (&se->pre, desc, 0); + + if (attr.pointer) + desc_attr = GFC_ATTRIBUTE_POINTER; + else if (attr.allocatable) + desc_attr = GFC_ATTRIBUTE_ALLOCATABLE; + else + desc_attr = GFC_ATTRIBUTE_OTHER; + gfc_conv_descriptor_attr_set (&se->pre, desc, desc_attr); /* Copy pointer address back - but only if it could have changed and if the actual argument is a pointer and not, e.g., NULL(). */ @@ -447,23 +468,37 @@ gfc_get_vptr_from_expr (tree expr) static void class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc, - bool lhs_type) + bool lhs_type, int rank, symbol_attribute attr) { tree tmp, tmp2, type; + int desc_attr; gfc_conv_descriptor_data_set (block, lhs_desc, gfc_conv_descriptor_data_get (rhs_desc)); gfc_conv_descriptor_offset_set (block, lhs_desc, gfc_conv_descriptor_offset_get (rhs_desc)); + type = gfc_get_element_type (TREE_TYPE (lhs_desc)); + gfc_conv_descriptor_elem_len_set (block, lhs_desc, TYPE_SIZE_UNIT (type)); + gfc_conv_descriptor_version_set (block, lhs_desc); + gfc_conv_descriptor_rank_set (block, lhs_desc, rank); gfc_add_modify (block, gfc_conv_descriptor_dtype (lhs_desc), gfc_conv_descriptor_dtype (rhs_desc)); + if (attr.pointer) + desc_attr = GFC_ATTRIBUTE_POINTER; + else if (attr.allocatable) + desc_attr = GFC_ATTRIBUTE_ALLOCATABLE; + else + desc_attr = GFC_ATTRIBUTE_OTHER; + gfc_conv_descriptor_attr_set (block, lhs_desc, desc_attr); + + /* Assign the dimension as range-ref. */ tmp = gfc_get_descriptor_dimension (lhs_desc); tmp2 = gfc_get_descriptor_dimension (rhs_desc); - type = lhs_type ? TREE_TYPE (tmp) : TREE_TYPE (tmp2); + tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp, gfc_index_zero_node, NULL_TREE, NULL_TREE); tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2, @@ -550,17 +585,33 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, if (class_ts.u.derived->components->as) { tree type; - type = get_scalar_to_descriptor_type (parmse->expr, - gfc_expr_attr (e)); - gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree), - gfc_get_dtype (type)); + int desc_attr; + symbol_attribute attr; + + attr = gfc_expr_attr (e); + type = get_scalar_to_descriptor_type (parmse->expr, attr); + if (optional) parmse->expr = build3_loc (input_location, COND_EXPR, TREE_TYPE (parmse->expr), cond_optional, parmse->expr, fold_convert (TREE_TYPE (parmse->expr), null_pointer_node)); + gfc_conv_descriptor_data_set (&parmse->pre, ctree, parmse->expr); + gfc_conv_descriptor_elem_len_set (&parmse->pre, ctree, TYPE_SIZE_UNIT (type)); + gfc_conv_descriptor_version_set (&parmse->pre, ctree); + gfc_conv_descriptor_rank_set (&parmse->pre, ctree, 0); + gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree), + gfc_get_dtype (&class_ts)); + + if (attr.pointer) + desc_attr = GFC_ATTRIBUTE_POINTER; + else if (attr.allocatable) + desc_attr = GFC_ATTRIBUTE_ALLOCATABLE; + else + desc_attr = GFC_ATTRIBUTE_OTHER; + gfc_conv_descriptor_attr_set (&parmse->pre, ctree, desc_attr); } else { @@ -585,7 +636,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, { gcc_assert (class_ts.u.derived->components->as->type == AS_ASSUMED_RANK); - class_array_data_assign (&block, ctree, parmse->expr, false); + class_array_data_assign (&block, ctree, parmse->expr, false, + e->rank, gfc_expr_attr (e)); } else { @@ -766,6 +818,9 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e, } else { + gfc_typespec *ts = &class_ts.u.derived->components->ts; + if (class_ts.u.derived->attr.unlimited_polymorphic) + ts = &e->ts; ss = gfc_walk_expr (e); if (ss == gfc_ss_terminator) { @@ -775,7 +830,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e, && class_ts.u.derived->components->as->type == AS_ASSUMED_RANK) { tmp = gfc_conv_scalar_to_descriptor (parmse, parmse->expr, - gfc_expr_attr (e)); + gfc_expr_attr (e), ts); tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, TREE_TYPE (ctree), tmp); } @@ -927,10 +982,9 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, { if (e->rank == 0) { - tree type = get_scalar_to_descriptor_type (parmse->expr, - gfc_expr_attr (e)); + gfc_conv_descriptor_rank_set (&block, ctree, 0); gfc_add_modify (&block, gfc_conv_descriptor_dtype (ctree), - gfc_get_dtype (type)); + gfc_get_dtype (&e->ts)); tmp = gfc_class_data_get (parmse->expr); if (!POINTER_TYPE_P (TREE_TYPE (tmp))) @@ -939,7 +993,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, gfc_conv_descriptor_data_set (&block, ctree, tmp); } else - class_array_data_assign (&block, ctree, parmse->expr, false); + class_array_data_assign (&block, ctree, parmse->expr, false, + e->rank, gfc_expr_attr (e)); } else { @@ -961,7 +1016,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, gfc_add_modify (&parmse->post, gfc_class_data_get (parmse->expr), gfc_conv_descriptor_data_get (ctree)); else - class_array_data_assign (&parmse->post, parmse->expr, ctree, true); + class_array_data_assign (&parmse->post, parmse->expr, ctree, true, + e->rank, gfc_expr_attr (e)); } else gfc_add_modify (&parmse->post, parmse->expr, ctree); @@ -3817,8 +3873,8 @@ gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc) { tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - gfc_conv_descriptor_ubound_get (desc, dim), - gfc_conv_descriptor_lbound_get (desc, dim)); + gfc_conv_descriptor_extent_get (desc, dim), + gfc_index_one_node); tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, GFC_TYPE_ARRAY_LBOUND (type, n), tmp); @@ -4370,7 +4426,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, gfc_add_ss_to_loop (&loop, loop.temp_ss); /* Setup the scalarizing loops. */ - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); /* Pass the temporary descriptor back to the caller. */ info = &loop.temp_ss->info->data.array; @@ -4450,7 +4506,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, gfc_conv_ss_startstride (&loop2); /* Setup the scalarizing loops. */ - gfc_conv_loop_setup (&loop2, &expr->where); + gfc_conv_loop_setup (&loop2, &expr->where, &expr->ts); gfc_copy_loopinfo_to_se (&lse, &loop2); gfc_copy_loopinfo_to_se (&rse, &loop2); @@ -4546,15 +4602,6 @@ class_array_fcn: offset = gfc_index_zero_node; for (n = 0; n < dimen; n++) { - tmp = gfc_conv_descriptor_ubound_get (parmse->expr, - gfc_rank_cst[n]); - tmp = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, tmp, - gfc_index_one_node); - gfc_conv_descriptor_ubound_set (&parmse->pre, - parmse->expr, - gfc_rank_cst[n], - tmp); gfc_conv_descriptor_lbound_set (&parmse->pre, parmse->expr, gfc_rank_cst[n], @@ -5240,7 +5287,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && 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); + fsym->attr, + &e->ts); parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr); } @@ -5907,6 +5955,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, tmp, NULL_TREE, false, !comp->attr.pointer, callee_alloc, + &se->ss->info->expr->ts, + se->ss->info->string_length, &se->ss->info->expr->where); /* Pass the temporary as the first argument. */ @@ -5942,6 +5992,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, tmp, NULL_TREE, false, !sym->attr.pointer, callee_alloc, + &se->ss->info->expr->ts, + se->ss->info->string_length, &se->ss->info->expr->where); /* Pass the temporary as the first argument. */ @@ -6208,7 +6260,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, se->expr = gfc_evaluate_now (se->expr, &se->pre); tmp = gfc_class_data_get (se->expr); tmp = gfc_conv_scalar_to_descriptor (se, tmp, - CLASS_DATA (expr->value.function.esym->result)->attr); + CLASS_DATA (expr->value.function.esym->result)->attr, + &expr->ts); } final_fndecl = gfc_class_vtab_final_get (se->expr); @@ -6664,7 +6717,7 @@ gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr) tree gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, - bool array, bool pointer, bool procptr) + bool array, bool pointer, bool procptr, int rank) { gfc_se se; @@ -6701,7 +6754,8 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, tree ctor; /* Arrays need special handling. */ if (pointer) - ctor = gfc_build_null_descriptor (type); + ctor = gfc_build_null_descriptor (type, rank, + GFC_ATTRIBUTE_POINTER, ts); /* Special case assigning an array to zero. */ else if (is_zero_initializer_p (expr)) ctor = build_constructor (type, NULL); @@ -6817,7 +6871,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) gfc_conv_ss_startstride (&loop); /* Setup the scalarizing loops. */ - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); @@ -6934,7 +6988,6 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm, for (n = 0; n < expr->rank; n++) { - tree span; tree lbound; /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9. @@ -6964,14 +7017,7 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm, lbound = fold_convert (gfc_array_index_type, lbound); - /* Shift the bounds and set the offset accordingly. */ - tmp = gfc_conv_descriptor_ubound_get (dest, gfc_rank_cst[n]); - span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - tmp, gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n])); - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - span, lbound); - gfc_conv_descriptor_ubound_set (&block, dest, - gfc_rank_cst[n], tmp); + /* Shift the lower_bound and set the offset accordingly. */ gfc_conv_descriptor_lbound_set (&block, dest, gfc_rank_cst[n], lbound); @@ -7451,7 +7497,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) val = gfc_conv_initializer (c->expr, &expr->ts, TREE_TYPE (cm->backend_decl), cm->attr.dimension, cm->attr.pointer, - cm->attr.proc_pointer); + cm->attr.proc_pointer, expr->rank); val = unshare_expr_without_location (val); /* Append it to the constructor list. */ @@ -7498,7 +7544,8 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) val = gfc_conv_initializer (c->expr, &cm->ts, TREE_TYPE (cm->backend_decl), cm->attr.dimension, cm->attr.pointer, - cm->attr.proc_pointer); + cm->attr.proc_pointer, + cm->as ? cm->as->rank : 0); val = unshare_expr_without_location (val); /* Append it to the constructor list. */ @@ -8048,19 +8095,29 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) converted in rse and now have to build the correct LHS descriptor for it. */ - tree dtype, data; + tree dtype, data, elem_len; tree offs, stride; tree lbound, ubound; /* Set dtype. */ - dtype = gfc_conv_descriptor_dtype (desc); - tmp = gfc_get_dtype (TREE_TYPE (desc)); - gfc_add_modify (&block, dtype, tmp); + if (expr1->ts.deferred || expr1->ts.type == BT_CLASS) + { + dtype = gfc_conv_descriptor_dtype (desc); + tmp = gfc_get_dtype (&expr2->ts); + gfc_add_modify (&block, dtype, tmp); + } /* Copy data pointer. */ data = gfc_conv_descriptor_data_get (rse.expr); gfc_conv_descriptor_data_set (&block, desc, data); + /* Copy element size. */ + elem_len = gfc_conv_descriptor_elem_len_get (rse.expr); + gfc_conv_descriptor_elem_len_set (&block, desc, elem_len); + + /* Set the new rank. */ + gfc_conv_descriptor_rank_set (&block, desc, expr1->rank); + /* Copy offset but adjust it such that it would correspond to a lbound of zero. */ offs = gfc_conv_descriptor_offset_get (rse.expr); @@ -8517,8 +8574,8 @@ arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2) reallocatable assignments from extrinsic function calls. */ static void -realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss, - gfc_loopinfo *loop) +realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_typespec *ts, + gfc_ss **ss, gfc_loopinfo *loop) { /* Signal that the function call should not be made by gfc_conv_loop_setup. */ @@ -8527,7 +8584,7 @@ realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss, gfc_add_ss_to_loop (loop, *ss); gfc_add_ss_to_loop (loop, se->ss); gfc_conv_ss_startstride (loop); - gfc_conv_loop_setup (loop, where); + gfc_conv_loop_setup (loop, where, ts); gfc_copy_loopinfo_to_se (se, loop); gfc_add_block_to_block (&se->pre, &loop->pre); gfc_add_block_to_block (&se->pre, &loop->post); @@ -8558,10 +8615,7 @@ fcncall_realloc_result (gfc_se *se, int rank) if (POINTER_TYPE_P (TREE_TYPE (desc))) desc = build_fold_indirect_ref_loc (input_location, desc); - /* Unallocated, the descriptor does not have a dtype. */ - tmp = gfc_conv_descriptor_dtype (desc); - gfc_add_modify (&se->pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); - + /* Unallocated, set descriptor to NULL. */ res_desc = gfc_evaluate_now (desc, &se->pre); gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node); se->expr = gfc_build_addr_expr (NULL_TREE, res_desc); @@ -8583,19 +8637,10 @@ fcncall_realloc_result (gfc_se *se, int rank) for (n = 0 ; n < rank; n++) { tree tmp1; - tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]); - tmp1 = gfc_conv_descriptor_lbound_get (res_desc, gfc_rank_cst[n]); - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, tmp, tmp1); - tmp1 = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]); - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, tmp, tmp1); - tmp1 = gfc_conv_descriptor_ubound_get (res_desc, gfc_rank_cst[n]); - tmp = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, tmp, tmp1); + tmp = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[n]); + tmp1 = gfc_conv_descriptor_extent_get (res_desc, gfc_rank_cst[n]); tmp = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tmp, - gfc_index_zero_node); + boolean_type_node, tmp, tmp1); tmp = gfc_evaluate_now (tmp, &se->post); zero_cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node, tmp, @@ -8708,7 +8753,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) ss = gfc_walk_expr (expr1); gcc_assert (ss != gfc_ss_terminator); - realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss, &loop); + realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &expr1->ts, + &ss, &loop); ss->is_alloc_lhs = 1; } else @@ -9295,7 +9341,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, /* Resolve any data dependencies in the statement. */ gfc_conv_resolve_dependencies (&loop, lss, rss); /* Setup the scalarizing loops. */ - gfc_conv_loop_setup (&loop, &expr2->where); + gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 81678428f18..ab6252e5e9d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1152,10 +1152,12 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, argse.string_length); else res_var = gfc_create_var (type, "caf_res"); - dst_var = gfc_conv_scalar_to_descriptor (&argse, res_var, attr); + dst_var = gfc_conv_scalar_to_descriptor (&argse, res_var, attr, + &array_expr->ts); dst_var = gfc_build_addr_expr (NULL_TREE, dst_var); } - argse.expr = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr); + argse.expr = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr, + &array_expr->ts); argse.expr = gfc_build_addr_expr (NULL_TREE, argse.expr); } else @@ -1178,9 +1180,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that has the wrong type if component references are done. */ gfc_add_modify (&argse.pre, gfc_conv_descriptor_dtype (argse.expr), - gfc_get_dtype_rank_type (has_vector ? ar2.dimen - : array_expr->rank, - type)); + gfc_get_dtype (&array_expr->ts)); if (has_vector) { vec = conv_caf_vector_subscript (&argse.pre, argse.expr, &ar2); @@ -1200,6 +1200,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, } gfc_trans_create_temp_array (&argse.pre, &argse.post, se->ss, type, NULL_TREE, false, true, false, + &array_expr->ts, NULL_TREE, &array_expr->where); res_var = se->ss->info->data.array.descriptor; dst_var = gfc_build_addr_expr (NULL_TREE, res_var); @@ -1276,7 +1277,8 @@ conv_caf_send (gfc_code *code) { gfc_clear_attr (&attr); gfc_conv_expr (&lhs_se, lhs_expr); lhs_type = TREE_TYPE (lhs_se.expr); - lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr); + lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr, attr, + &lhs_expr->ts); lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr); } else @@ -1302,9 +1304,7 @@ conv_caf_send (gfc_code *code) { lhs_type = gfc_typenode_for_spec (&lhs_expr->ts); tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr); gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp), - gfc_get_dtype_rank_type (has_vector ? ar2.dimen - : lhs_expr->rank, - lhs_type)); + gfc_get_dtype (&lhs_expr->ts)); if (has_vector) { vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2); @@ -1349,7 +1349,8 @@ conv_caf_send (gfc_code *code) { gfc_conv_expr (&rhs_se, rhs_expr); if (!gfc_is_coindexed (rhs_expr) && rhs_expr->ts.type != BT_CHARACTER) rhs_se.expr = fold_convert (lhs_type , rhs_se.expr); - rhs_se.expr = gfc_conv_scalar_to_descriptor (&rhs_se, rhs_se.expr, attr); + rhs_se.expr = gfc_conv_scalar_to_descriptor (&rhs_se, rhs_se.expr, attr, + &rhs_expr->ts); rhs_se.expr = gfc_build_addr_expr (NULL_TREE, rhs_se.expr); } else @@ -1358,7 +1359,6 @@ conv_caf_send (gfc_code *code) { vector bounds separately. */ gfc_array_ref *ar, ar2; bool has_vector = false; - tree tmp2; if (gfc_is_coindexed (rhs_expr) && gfc_has_vector_subscript (rhs_expr)) { @@ -1374,11 +1374,8 @@ conv_caf_send (gfc_code *code) { /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that has the wrong type if component references are done. */ tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr); - tmp2 = gfc_typenode_for_spec (&rhs_expr->ts); gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp), - gfc_get_dtype_rank_type (has_vector ? ar2.dimen - : rhs_expr->rank, - tmp2)); + gfc_get_dtype (&rhs_expr->ts)); if (has_vector) { rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, &ar2); @@ -1454,7 +1451,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) { stmtblock_t loop; tree type, desc, dim_arg, cond, tmp, m, loop_var, exit_label, min_var, - lbound, ubound, extent, ml; + lbound, extent, ml; gfc_se argse; int rank, corank; gfc_expr *distance = expr->value.function.actual->next->next->expr; @@ -1622,10 +1619,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) gfc_add_modify (&loop, ml, m); /* extent = ... */ - lbound = gfc_conv_descriptor_lbound_get (desc, loop_var); - ubound = gfc_conv_descriptor_ubound_get (desc, loop_var); - extent = gfc_conv_array_extent_dim (lbound, ubound, NULL); - extent = fold_convert (type, extent); + extent = fold_convert (type, gfc_conv_descriptor_extent_get (desc, loop_var)); /* m = m/extent. */ gfc_add_modify (&loop, m, @@ -1747,12 +1741,11 @@ trans_image_index (gfc_se * se, gfc_expr *expr) for (codim = corank + rank - 2; codim >= rank; codim--) { - tree extent, ubound; + tree extent; /* coindex = coindex*extent(codim) + sub(codim) - lcobound(codim). */ lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[codim]); - ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[codim]); - extent = gfc_conv_array_extent_dim (lbound, ubound, NULL); + extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[codim]); /* coindex *= extent. */ coindex = fold_build2_loc (input_location, MULT_EXPR, @@ -1846,7 +1839,8 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr) gfc_add_block_to_block (&se->pre, &argse.pre); 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), + gfc_conv_descriptor_rank (argse.expr)); } @@ -1862,12 +1856,14 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) tree type; tree bound; tree tmp; - tree cond, cond1, cond3, cond4, size; - tree ubound; + tree cond; tree lbound; + tree extent; gfc_se argse; + gfc_ref *ref; + gfc_array_ref *ar; gfc_array_spec * as; - bool assumed_rank_lb_one; + bool lb_one; arg = expr->value.function.actual; arg2 = arg->next; @@ -1901,13 +1897,20 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) /* TODO: don't re-evaluate the descriptor on each iteration. */ /* Get a descriptor for the first parameter. */ gfc_init_se (&argse, NULL); + argse.data_not_needed = 1; gfc_conv_expr_descriptor (&argse, arg->expr); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); desc = argse.expr; - as = gfc_get_full_arrayspec_from_expr (arg->expr); + for (ref = arg->expr->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY + && (ref->u.ar.type == AR_FULL || ref->u.ar.type == AR_SECTION)) + break; + + ar = ref ? &ref->u.ar : NULL; + as = ar ? ar->as : NULL; if (INTEGER_CST_P (bound)) { @@ -1931,7 +1934,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) else tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, - bound, fold_convert(TREE_TYPE (bound), tmp)); + bound, fold_convert (TREE_TYPE (bound), tmp)); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, @@ -1940,17 +1943,21 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) } /* Take care of the lbound shift for assumed-rank arrays, which are - nonallocatable and nonpointers. Those has a lbound of 1. */ - assumed_rank_lb_one = as && as->type == AS_ASSUMED_RANK - && ((arg->expr->ts.type != BT_CLASS - && !arg->expr->symtree->n.sym->attr.allocatable - && !arg->expr->symtree->n.sym->attr.pointer) - || (arg->expr->ts.type == BT_CLASS - && !CLASS_DATA (arg->expr)->attr.allocatable - && !CLASS_DATA (arg->expr)->attr.class_pointer)); - - ubound = gfc_conv_descriptor_ubound_get (desc, bound); + nonallocatable and nonpointers. Those have a lbound of 1. */ + lb_one = as && as->type == AS_ASSUMED_RANK + && ((arg->expr->ts.type != BT_CLASS + && !arg->expr->symtree->n.sym->attr.allocatable + && !arg->expr->symtree->n.sym->attr.pointer) + || (arg->expr->ts.type == BT_CLASS + && !CLASS_DATA (arg->expr)->attr.allocatable + && !CLASS_DATA (arg->expr)->attr.class_pointer)); + lb_one = lb_one || ar == NULL || ar->type != AR_FULL; + + if (ref && ref->next) + lb_one = true; + lbound = gfc_conv_descriptor_lbound_get (desc, bound); + extent = gfc_conv_descriptor_extent_get (desc, bound); /* 13.14.53: Result value for LBOUND @@ -1973,82 +1980,43 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) not have size zero and has value zero if dimension DIM has size zero. */ - if (!upper && assumed_rank_lb_one) + if (!upper && lb_one) se->expr = gfc_index_one_node; - else if (as) + else if (lb_one) + se->expr = extent; + else { - tree stride = gfc_conv_descriptor_stride_get (desc, bound); - - cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, - ubound, lbound); - cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, - stride, gfc_index_zero_node); - cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, cond3, cond1); - cond4 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, - stride, gfc_index_zero_node); - - if (upper) + cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + extent, gfc_index_zero_node); + if (!upper) { - tree cond5; - cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond3, cond4); - cond5 = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - gfc_index_one_node, lbound); - cond5 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, cond4, cond5); + tree cond2; - cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond, cond5); + if (as->type == AS_ASSUMED_SIZE) + cond2 = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + bound, + build_int_cst (TREE_TYPE (bound), + arg->expr->rank - 1)); + else + cond2 = boolean_false_node; - if (assumed_rank_lb_one) - { - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, ubound, lbound); - tmp = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, tmp, gfc_index_one_node); - } - else - tmp = ubound; + cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, + boolean_type_node, cond, cond2); se->expr = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond, - tmp, gfc_index_zero_node); + lbound, gfc_index_one_node); } else { - if (as->type == AS_ASSUMED_SIZE) - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - bound, build_int_cst (TREE_TYPE (bound), - arg->expr->rank - 1)); - else - cond = boolean_false_node; - - cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond3, cond4); - cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond, cond1); - + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, extent, lbound); + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, tmp, gfc_index_one_node); se->expr = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond, - lbound, gfc_index_one_node); - } - } - else - { - if (upper) - { - size = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, ubound, lbound); - se->expr = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, size, - gfc_index_one_node); - se->expr = fold_build2_loc (input_location, MAX_EXPR, - gfc_array_index_type, se->expr, - gfc_index_zero_node); + tmp, gfc_index_zero_node); } - else - se->expr = gfc_index_one_node; } type = gfc_typenode_for_spec (&expr->ts); @@ -3221,7 +3189,7 @@ gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, enum tree_code op) /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); gfc_mark_ss_chain_used (arrayss, 1); /* Generate the loop body. */ @@ -3303,7 +3271,7 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr) /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); gfc_mark_ss_chain_used (arrayss, 1); /* Generate the loop body. */ @@ -3437,7 +3405,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); gfc_mark_ss_chain_used (arrayss, 1); if (maskexpr && maskexpr->rank > 0) @@ -3658,7 +3626,7 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr) /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); gfc_mark_ss_chain_used (arrayss1, 1); gfc_mark_ss_chain_used (arrayss2, 1); @@ -3899,7 +3867,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) loops (without conflicting with temporary management), or use a single loop minmaxloc implementation. See PR 31067. */ loop.temp_dim = loop.dimen; - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); gcc_assert (loop.dimen == 1); if (nonempty == NULL && maskss == NULL && loop.from[0] && loop.to[0]) @@ -4355,7 +4323,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) loops (without conflicting with temporary management), or use a single loop minmaxval implementation. See PR 31067. */ loop.temp_dim = loop.dimen; - gfc_conv_loop_setup (&loop, &expr->where); + gfc_conv_loop_setup (&loop, &expr->where, &expr->ts); if (nonempty == NULL && maskss == NULL && loop.dimen == 1 && loop.from[0] && loop.to[0]) @@ -5830,100 +5798,182 @@ gfc_conv_intrinsic_set_exponent (gfc_se * se, gfc_expr * expr) static void -gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) +gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr, bool shape) { - gfc_actual_arglist *actual; - tree arg1; + gfc_actual_arglist *arg; + gfc_actual_arglist *arg2; + tree desc; tree type; - tree fncall0; - tree fncall1; + tree exit_label, tmp, cond, extent, size; + tree arg2_var = NULL_TREE, present = NULL_TREE, bound = NULL_TREE; gfc_se argse; + gfc_array_spec * as; + stmtblock_t loop; + bool optional; - gfc_init_se (&argse, NULL); - actual = expr->value.function.actual; + arg = expr->value.function.actual; + arg2 = arg->next; - if (actual->expr->ts.type == BT_CLASS) - gfc_add_class_array_ref (actual->expr); + optional = !shape && arg2->expr && arg2->expr->expr_type == EXPR_VARIABLE + && arg2->expr->symtree->n.sym->attr.optional && !arg2->expr->ref; - argse.want_pointer = 1; + /* For SIZE, the dim= variable can be an optional, which requires special + handling. */ + + if (se->ss) + { + /* Create an implicit second parameter from the loop variable. */ + gcc_assert (shape); + gcc_assert (se->loop->dimen == 1); + gcc_assert (se->ss->info->expr == expr); + gfc_advance_se_ss_chain (se); + bound = se->loop->loopvar[0]; + bound = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, bound, + se->loop->from[0]); + } + else if (arg2->expr) + { + /* use the passed argument. */ + gcc_assert (!shape); + gfc_init_se (&argse, NULL); + gfc_conv_expr_type (&argse, arg2->expr, gfc_array_index_type); + gfc_add_block_to_block (&se->pre, &argse.pre); + arg2_var = argse.expr; + /* Convert from one based to zero based. */ + if (!optional) + bound = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, arg2_var, + gfc_index_one_node); + } + + if (!se->ss && (!arg2->expr || optional)) + { + /* SIZE without dim= - or with optional dim. */ + gcc_assert (!shape); + bound = gfc_create_var (integer_type_node, NULL); + + if (optional) + present = gfc_conv_expr_present (arg2->expr->symtree->n.sym); + } + + /* TODO: don't re-evaluate the descriptor on each iteration. */ + /* Get a descriptor for the first parameter. */ + gfc_init_se (&argse, NULL); argse.data_not_needed = 1; - gfc_conv_expr_descriptor (&argse, actual->expr); + gfc_conv_expr_descriptor (&argse, arg->expr); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); - arg1 = gfc_evaluate_now (argse.expr, &se->pre); - /* Build the call to size0. */ - fncall0 = build_call_expr_loc (input_location, - gfor_fndecl_size0, 1, arg1); + desc = argse.expr; - actual = actual->next; + as = gfc_get_full_arrayspec_from_expr (arg->expr); + + if (arg2_var != NULL_TREE && INTEGER_CST_P (arg2_var) + && (((!as || as->type != AS_ASSUMED_RANK) + && wi::geu_p (bound, GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))) + || wi::gtu_p (bound, GFC_MAX_DIMENSIONS))) + gfc_error ("'dim' argument of SIZE intrinsic at %L is not a valid " + "dimension index", &expr->where); - if (actual->expr) + if (arg2_var != NULL_TREE + && (!INTEGER_CST_P (arg2_var) || (as && as->type == AS_ASSUMED_RANK))) { - gfc_init_se (&argse, NULL); - gfc_conv_expr_type (&argse, actual->expr, - gfc_array_index_type); - gfc_add_block_to_block (&se->pre, &argse.pre); + if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + { + arg2_var = gfc_evaluate_now (arg2_var, &se->pre); + cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + arg2_var, + build_int_cst (TREE_TYPE (arg2_var), 1)); + if (as && as->type == AS_ASSUMED_RANK) + tmp = gfc_conv_descriptor_rank (desc); + else + tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; + tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + arg2_var, + fold_convert (TREE_TYPE (arg2_var), tmp)); + cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + boolean_type_node, cond, tmp); + if (optional) + cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + boolean_type_node, present, cond); + gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, + gfc_msg_fault); + } + } - /* Unusually, for an intrinsic, size does not exclude - an optional arg2, so we must test for it. */ - if (actual->expr->expr_type == EXPR_VARIABLE - && actual->expr->symtree->n.sym->attr.dummy - && actual->expr->symtree->n.sym->attr.optional) - { - tree tmp; - /* Build the call to size1. */ - fncall1 = build_call_expr_loc (input_location, - gfor_fndecl_size1, 2, - arg1, argse.expr); + extent = gfc_conv_descriptor_extent_get (desc, bound); + type = gfc_typenode_for_spec (&expr->ts); - gfc_init_se (&argse, NULL); - argse.want_pointer = 1; - argse.data_not_needed = 1; - gfc_conv_expr (&argse, actual->expr); - gfc_add_block_to_block (&se->pre, &argse.pre); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - argse.expr, null_pointer_node); - tmp = gfc_evaluate_now (tmp, &se->pre); - se->expr = fold_build3_loc (input_location, COND_EXPR, - pvoid_type_node, tmp, fncall1, fncall0); - } - else - { - se->expr = NULL_TREE; - argse.expr = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - argse.expr, gfc_index_one_node); - } - } - else if (expr->value.function.actual->expr->rank == 1) + if (shape || (arg2->expr && !optional)) { - argse.expr = gfc_index_zero_node; - se->expr = NULL_TREE; + se->expr = convert (type, extent); + return; } - else - se->expr = fncall0; - if (se->expr == NULL_TREE) - { - tree ubound, lbound; + /* bound = 0; - or: bound = present ? arg2_var - 1 : 0; + size = 1; + for (;;) + { + if (bound >= rank) - or: if (bound >= (present ? arg2_var : rank)) + goto exit; + size = size * extent[bound]; + bound++; + } + exit: */ - arg1 = build_fold_indirect_ref_loc (input_location, - arg1); - ubound = gfc_conv_descriptor_ubound_get (arg1, argse.expr); - lbound = gfc_conv_descriptor_lbound_get (arg1, argse.expr); - se->expr = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, ubound, lbound); - se->expr = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, - se->expr, gfc_index_one_node); - se->expr = fold_build2_loc (input_location, MAX_EXPR, - gfc_array_index_type, se->expr, - gfc_index_zero_node); + /* bound = 0; - or: bound = present ? arg2_var : 0; */ + tmp = build_int_cst (integer_type_node, 0); + if (optional) + { + tree tmp2 = fold_build2_loc (input_location, MINUS_EXPR, + integer_type_node, + fold_convert (integer_type_node, arg2_var), + build_int_cst (integer_type_node, 1)); + tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, + present, tmp2, tmp); } + gfc_add_modify (&se->pre, bound, tmp); - type = gfc_typenode_for_spec (&expr->ts); - se->expr = convert (type, se->expr); + exit_label = gfc_build_label_decl (NULL_TREE); + TREE_USED (exit_label) = 1; + + size = gfc_create_var (gfc_array_index_type, NULL); + gfc_add_modify (&se->pre, size, gfc_index_one_node); + + gfc_init_block (&loop); + + /* Exit condition: if (bound >= rank-1) goto exit_label. */ + tmp = fold_convert (integer_type_node, gfc_conv_descriptor_rank (desc)); + if (optional) + tmp = fold_build3_loc (input_location, COND_EXPR, + integer_type_node, present, + fold_convert (integer_type_node, arg2_var), tmp); + cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, bound, + tmp); + tmp = build1_v (GOTO_EXPR, exit_label); + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&loop, tmp); + + gfc_add_modify (&loop, size, + fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, extent)); + + gfc_add_modify (&loop, bound, + fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, + bound, + build_int_cst (integer_type_node, 1))); + + tmp = gfc_finish_block (&loop); + tmp = build1_v (LOOP_EXPR, tmp); + gfc_add_expr_to_block (&se->pre, tmp); + + /* The exit label. */ + tmp = build1_v (LABEL_EXPR, exit_label); + gfc_add_expr_to_block (&se->pre, tmp); + + se->expr = convert (type, size); } @@ -5953,8 +6003,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) gfc_se argse; tree source_bytes; tree tmp; - tree lower; - tree upper; tree byte_size; int n; @@ -5978,10 +6026,7 @@ 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_elem_len_get (tmp); byte_size = fold_convert (gfc_array_index_type, tmp); } else if (arg->ts.type == BT_CLASS) @@ -6056,9 +6101,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) cond, tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&body, tmp); - lower = gfc_conv_descriptor_lbound_get (argse.expr, loop_var); - upper = gfc_conv_descriptor_ubound_get (argse.expr, loop_var); - tmp = gfc_conv_array_extent_dim (lower, upper, NULL); + tmp = gfc_conv_descriptor_extent_get (argse.expr, loop_var); tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, tmp, source_bytes); gfc_add_modify (&body, source_bytes, tmp); @@ -6084,9 +6127,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) { tree idx; idx = gfc_rank_cst[n]; - lower = gfc_conv_descriptor_lbound_get (argse.expr, idx); - upper = gfc_conv_descriptor_ubound_get (argse.expr, idx); - tmp = gfc_conv_array_extent_dim (lower, upper, NULL); + tmp = gfc_conv_descriptor_extent_get (argse.expr, idx); tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, tmp, source_bytes); gfc_add_modify (&argse.pre, source_bytes, tmp); @@ -6483,7 +6524,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) /* Build a destination descriptor, using the pointer, source, as the data field. */ gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type, - NULL_TREE, false, true, false, &expr->where); + NULL_TREE, false, true, false, + &expr->ts, NULL_TREE, &expr->where); /* Cast the pointer to the result. */ tmp = gfc_conv_descriptor_data_get (info->descriptor); @@ -6762,6 +6804,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) present. */ arg1se.descriptor_only = 1; gfc_conv_expr_lhs (&arg1se, arg1->expr); + if (arg1->expr->rank == -1) { tmp = gfc_conv_descriptor_rank (arg1se.expr); @@ -6770,7 +6813,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) } else tmp = gfc_rank_cst[arg1->expr->rank - 1]; - tmp = gfc_conv_descriptor_stride_get (arg1se.expr, tmp); + + tmp = gfc_conv_descriptor_sm_get (arg1se.expr, tmp); nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); @@ -7279,7 +7323,7 @@ conv_isocbinding_subroutine (gfc_code *code) gfc_se fptrse; gfc_se shapese; gfc_ss *shape_ss; - tree desc, dim, tmp, stride, offset; + tree desc, dim, tmp, sm, offset; stmtblock_t body, block; gfc_loopinfo loop; gfc_actual_arglist *arg = code->ext.actual; @@ -7319,11 +7363,12 @@ conv_isocbinding_subroutine (gfc_code *code) gfc_add_block_to_block (&block, &fptrse.pre); desc = fptrse.expr; - /* Set data value, dtype, and offset. */ + /* Set data value, rank, dtype, and offset. */ tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)); gfc_conv_descriptor_data_set (&block, desc, fold_convert (tmp, cptrse.expr)); + gfc_conv_descriptor_rank_set (&block, desc, arg->next->expr->rank); gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc), - gfc_get_dtype (TREE_TYPE (desc))); + gfc_get_dtype (&arg->next->expr->ts)); /* Start scalarization of the bounds, using the shape argument. */ @@ -7334,15 +7379,17 @@ conv_isocbinding_subroutine (gfc_code *code) gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, shape_ss); gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &arg->next->expr->where); + gfc_conv_loop_setup (&loop, &arg->next->expr->where, &arg->next->expr->ts); gfc_mark_ss_chain_used (shape_ss, 1); gfc_copy_loopinfo_to_se (&shapese, &loop); shapese.ss = shape_ss; - stride = gfc_create_var (gfc_array_index_type, "stride"); + sm = gfc_create_var (gfc_array_index_type, "sm"); offset = gfc_create_var (gfc_array_index_type, "offset"); - gfc_add_modify (&block, stride, gfc_index_one_node); + tmp = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); + gfc_conv_descriptor_elem_len_set (&block, desc, tmp); + gfc_add_modify (&block, sm, fold_convert (TREE_TYPE (sm), tmp)); gfc_add_modify (&block, offset, gfc_index_zero_node); /* Loop body. */ @@ -7351,23 +7398,28 @@ conv_isocbinding_subroutine (gfc_code *code) dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, loop.loopvar[0], loop.from[0]); - /* Set bounds and stride. */ + /* Set bounds and stride multiplier. */ gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node); - gfc_conv_descriptor_stride_set (&body, desc, dim, stride); + gfc_conv_descriptor_sm_set (&body, desc, dim, sm); gfc_conv_expr (&shapese, arg->next->next->expr); gfc_add_block_to_block (&body, &shapese.pre); - gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr); + gfc_conv_descriptor_extent_set (&body, desc, dim, shapese.expr); gfc_add_block_to_block (&body, &shapese.post); - /* Calculate offset. */ + /* Calculate offset. Change from the stride multiplier back to the + stride. */ + tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_array_index_type, sm, + fold_convert (TREE_TYPE (sm), tmp)); gfc_add_modify (&body, offset, fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, offset, stride)); - /* Update stride. */ - gfc_add_modify (&body, stride, + gfc_array_index_type, offset, tmp)); + + /* Update stride multiplier. */ + gfc_add_modify (&body, sm, fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, stride, + gfc_array_index_type, sm, fold_convert (gfc_array_index_type, shapese.expr))); /* Finish scalarization loop. */ @@ -8263,12 +8315,16 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_scale (se, expr); break; + case GFC_ISYM_SHAPE: + gfc_conv_intrinsic_size (se, expr, true); + break; + case GFC_ISYM_SIGN: gfc_conv_intrinsic_sign (se, expr); break; case GFC_ISYM_SIZE: - gfc_conv_intrinsic_size (se, expr); + gfc_conv_intrinsic_size (se, expr, false); break; case GFC_ISYM_SIZEOF: @@ -8575,6 +8631,7 @@ gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss) case GFC_ISYM_LBOUND: case GFC_ISYM_UCOBOUND: case GFC_ISYM_LCOBOUND: + case GFC_ISYM_SHAPE: case GFC_ISYM_THIS_IMAGE: break; @@ -8593,8 +8650,9 @@ gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr) if (expr->value.function.actual->expr->ts.type == BT_CLASS) gfc_add_class_array_ref (expr->value.function.actual->expr); - /* The two argument version returns a scalar. */ - if (expr->value.function.actual->next->expr) + /* The two argument version returns a scalar, except for SHAPE. */ + if (expr->value.function.isym->id != GFC_ISYM_SHAPE + && expr->value.function.actual->next->expr) return ss; return gfc_get_array_ss (ss, expr, 1, GFC_SS_INTRINSIC); @@ -8677,7 +8735,6 @@ gfc_is_intrinsic_libcall (gfc_expr * expr) case GFC_ISYM_PARITY: case GFC_ISYM_PRODUCT: case GFC_ISYM_SUM: - case GFC_ISYM_SHAPE: case GFC_ISYM_SPREAD: case GFC_ISYM_YN2: /* Ignore absent optional parameters. */ @@ -8724,6 +8781,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, case GFC_ISYM_UBOUND: case GFC_ISYM_UCOBOUND: case GFC_ISYM_THIS_IMAGE: + case GFC_ISYM_SHAPE: return gfc_walk_intrinsic_bound (ss, expr); case GFC_ISYM_TRANSFER: @@ -8800,7 +8858,8 @@ conv_co_collective (gfc_code *code) gfc_conv_expr (&argse, code->ext.actual->expr); gfc_add_block_to_block (&block, &argse.pre); gfc_add_block_to_block (&post_block, &argse.post); - array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr); + array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr, + &code->ext.actual->expr->ts); array = gfc_build_addr_expr (NULL_TREE, array); } else diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 2c843497295..c4781dc39e5 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -471,14 +471,15 @@ 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); + void_type_node, 7, 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); 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, + void_type_node, 9, 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); + gfc_int4_type_node, pvoid_type_node, pvoid_type_node); iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("st_set_nml_var_dim")), ".w", @@ -755,16 +756,10 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e) else { gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); - size = gfc_conv_array_stride (array, rank); - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - gfc_conv_array_ubound (array, rank), - gfc_conv_array_lbound (array, rank)); - tmp = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, tmp, - gfc_index_one_node); size = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, tmp, size); + gfc_array_index_type, + gfc_conv_array_stride (array, rank), + gfc_conv_array_extent (array, rank)); } gcc_assert (size); @@ -1630,14 +1625,13 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, tree dt = NULL; tree string; tree tmp; - tree dtype; + tree elem_len; tree dt_parm_addr; tree decl = NULL_TREE; tree gfc_int4_type_node = gfc_get_int_type (4); - tree dtio_proc = null_pointer_node; - tree vtable = null_pointer_node; + tree dtio_proc = NULL_TREE; + tree vtable = NULL_TREE; int n_dim; - int itype; int rank = 0; gcc_assert (sym || c); @@ -1657,23 +1651,29 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, if (as) rank = as->rank; + decl = (sym) ? sym->backend_decl : c->backend_decl; if (rank) { - decl = (sym) ? sym->backend_decl : c->backend_decl; if (sym && sym->attr.dummy) decl = build_fold_indirect_ref_loc (input_location, decl); dt = TREE_TYPE (decl); - dtype = gfc_get_dtype (dt); + tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dt)); } else { - itype = ts->type; - dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT); + tmp = TREE_TYPE (decl); + if (TREE_CODE (tmp) == REFERENCE_TYPE) + tmp = TREE_TYPE (tmp); + if (POINTER_TYPE_P (tmp) || TREE_CODE (tmp) == REFERENCE_TYPE) + tmp = TREE_TYPE (tmp); + tmp = TYPE_SIZE_UNIT (tmp); } + elem_len = tmp; + /* Build up the arguments for the transfer call. The call for the scalar part transfers: - (address, name, type, kind or string_length, dtype) */ + (address, name, kind, elem_len, type) */ dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm); @@ -1700,22 +1700,35 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, } if (ts->type == BT_CHARACTER) - tmp = ts->u.cl->backend_decl; + { + elem_len = ts->u.cl->backend_decl; + tmp = build_int_cst (gfc_charlen_type_node, ts->kind); + elem_len = fold_build2_loc (input_location, MULT_EXPR, + gfc_charlen_type_node, + elem_len, tmp); + gfc_evaluate_now (elem_len, block); + } else - tmp = build_int_cst (gfc_charlen_type_node, 0); + elem_len = fold_convert (gfc_charlen_type_node, elem_len); + if (dtio_proc == NULL_TREE) tmp = build_call_expr_loc (input_location, - iocall[IOCALL_SET_NML_VAL], 6, + iocall[IOCALL_SET_NML_VAL], 7, dt_parm_addr, addr_expr, string, build_int_cst (gfc_int4_type_node, ts->kind), - tmp, dtype); + elem_len, + build_int_cst (gfc_int4_type_node, rank), + build_int_cst (gfc_int4_type_node, ts->type)); else tmp = build_call_expr_loc (input_location, - iocall[IOCALL_SET_NML_DTIO_VAL], 8, + iocall[IOCALL_SET_NML_DTIO_VAL], 9, dt_parm_addr, addr_expr, string, build_int_cst (gfc_int4_type_node, ts->kind), - tmp, dtype, dtio_proc, vtable); + elem_len, + build_int_cst (gfc_int4_type_node, rank), + build_int_cst (integer_type_node, ts->type), + dtio_proc, vtable); gfc_add_expr_to_block (block, tmp); /* If the object is an array, transfer rank times: @@ -1727,14 +1740,14 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, iocall[IOCALL_SET_NML_VAL_DIM], 5, dt_parm_addr, build_int_cst (gfc_int4_type_node, n_dim), - gfc_conv_array_stride (decl, n_dim), gfc_conv_array_lbound (decl, n_dim), - gfc_conv_array_ubound (decl, n_dim)); + gfc_conv_array_extent (decl, n_dim), + gfc_conv_array_sm (decl, n_dim)); gfc_add_expr_to_block (block, tmp); } if (gfc_bt_struct (ts->type) && ts->u.derived->components - && dtio_proc == null_pointer_node) + && dtio_proc == NULL_TREE) { gfc_component *cmp; @@ -2097,7 +2110,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, ss); gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, where); + gfc_conv_loop_setup (&loop, where, &cm->ts); gfc_mark_ss_chain_used (ss, 1); gfc_start_scalarized_body (&loop, &body); @@ -2513,7 +2526,7 @@ gfc_trans_transfer (gfc_code * code) /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &code->expr1->where); + gfc_conv_loop_setup (&loop, &code->expr1->where, &code->expr1->ts); /* The main loop body. */ gfc_mark_ss_chain_used (ss, 1); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index e4a2975719e..4f1a1beb8cc 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -481,12 +481,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) { gfc_add_modify (&cond_block, decl, outer); tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (decl, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, - gfc_conv_descriptor_lbound_get (decl, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); + size = gfc_conv_descriptor_extent_get (decl, rank); if (GFC_TYPE_ARRAY_RANK (type) > 1) size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, @@ -585,12 +580,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) if (GFC_DESCRIPTOR_TYPE_P (type)) { tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (dest, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, - gfc_conv_descriptor_lbound_get (dest, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); + size = gfc_conv_descriptor_extent_get (dest, rank); if (GFC_TYPE_ARRAY_RANK (type) > 1) size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, @@ -704,12 +694,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) if (GFC_DESCRIPTOR_TYPE_P (type)) { tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (src, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, - gfc_conv_descriptor_lbound_get (src, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); + size = gfc_conv_descriptor_extent_get (dest, rank); if (GFC_TYPE_ARRAY_RANK (type) > 1) size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 5884e7a4e24..46205302218 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -291,16 +291,14 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, if (e->ts.type != BT_CLASS) { - /* Find the type of the temporary to create; we don't use the type - of e itself as this breaks for subcomponent-references in e - (where the type of e is that of the final reference, but - parmse.expr's type corresponds to the full derived-type). */ - /* TODO: Fix this somehow so we don't need a temporary of the whole - array but instead only the components referenced. */ - temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor. */ - gcc_assert (TREE_CODE (temptype) == POINTER_TYPE); - temptype = TREE_TYPE (temptype); - temptype = gfc_get_element_type (temptype); + /* Set the type of the temporary to create using that of + the element type of the descriptor. */ + for (tmp = parmse.expr; tmp; tmp = TREE_OPERAND (tmp, 0)) + { + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + break; + } + temptype = gfc_get_element_type (TREE_TYPE (tmp)); } else @@ -316,7 +314,8 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, gfc_init_block (&temp_post); tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss, temptype, initial, false, true, - false, &arg->expr->where); + false, &e->ts, se->string_length, + &arg->expr->where); gfc_add_modify (&se->pre, size, tmp); tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data); gfc_add_modify (&se->pre, data, tmp); @@ -452,7 +451,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, subscripts. This could be prevented in the elemental case as temporaries are handled separatedly (below in gfc_conv_elemental_dependencies). */ - gfc_conv_loop_setup (&loop, &code->expr1->where); + gfc_conv_loop_setup (&loop, &code->expr1->where, &code->expr1->ts); gfc_mark_ss_chain_used (ss, 1); /* Convert the arguments, checking for dependencies. */ @@ -1536,7 +1535,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) && (sym->as->type == AS_DEFERRED || sym->assoc->variable)) { gfc_se se; - tree desc; bool cst_array_ctor; desc = sym->backend_decl; @@ -1623,11 +1621,26 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) if (unlimited) { - /* Recover the dtype, which has been overwritten by the - assignment from an unlimited polymorphic object. */ - tmp = gfc_conv_descriptor_dtype (sym->backend_decl); - gfc_add_modify (&se.pre, tmp, - gfc_get_dtype (TREE_TYPE (sym->backend_decl))); + /* Generate the dtype, element length and stride measures, which + have been overwritten by the assignment from an unlimited + polymorphic object. */ + tree tdesc; + tdesc = gfc_build_null_descriptor (TREE_TYPE (sym->backend_decl), + e->rank, GFC_ATTRIBUTE_OTHER, + &sym->ts); + tmp = gfc_conv_descriptor_dtype (tdesc); + gfc_add_modify (&se.pre, + gfc_conv_descriptor_dtype (sym->backend_decl), tmp); + + tmp = gfc_conv_descriptor_elem_len_get (tdesc); + gfc_conv_descriptor_elem_len_set (&se.pre, sym->backend_decl, tmp); + + for (n = 0; n < e->rank; n++) + { + gfc_conv_descriptor_sm_get (tdesc, gfc_rank_cst[n]); + gfc_conv_descriptor_sm_set (&se.pre, sym->backend_decl, + gfc_rank_cst[n], tmp); + } } gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), @@ -1665,12 +1678,16 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) dim = gfc_rank_cst[n]; tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - gfc_conv_descriptor_stride_get (desc, dim), + gfc_conv_descriptor_sm_get (desc, dim), gfc_conv_descriptor_lbound_get (desc, dim)); offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, offset, tmp); } + tmp = fold_convert (gfc_array_index_type, + gfc_conv_descriptor_elem_len_get (desc)); + offset = fold_build2_loc (input_location, FLOOR_DIV_EXPR, + gfc_array_index_type, offset, tmp); if (need_len_assign) { if (e->symtree @@ -3424,7 +3441,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3, /* Calculate the bounds of the scalarization. */ gfc_conv_ss_startstride (&loop1); /* Setup the scalarizing loops. */ - gfc_conv_loop_setup (&loop1, &expr->where); + gfc_conv_loop_setup (&loop1, &expr->where, &expr->ts); gfc_mark_ss_chain_used (lss, 1); @@ -3524,7 +3541,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3, gfc_add_ss_to_loop (&loop, rss); gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr2->where); + gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts); gfc_mark_ss_chain_used (rss, 1); /* Start the loop body. */ @@ -3643,7 +3660,7 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2, gfc_option.rtcheck &= ~GFC_RTCHECK_BOUNDS; gfc_conv_ss_startstride (&loop); gfc_option.rtcheck = save_flag; - gfc_conv_loop_setup (&loop, &expr2->where); + gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts); /* Figure out how many elements we need. */ for (i = 0; i < loop.dimen; i++) @@ -3988,7 +4005,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, /* Setup the scalarizing loops and bounds. */ gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr2->where); + gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts); info = &rss->info->data.array; desc = info->descriptor; @@ -4507,7 +4524,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info, gfc_add_ss_to_loop (&loop, rss); gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &me->where); + gfc_conv_loop_setup (&loop, &me->where, &me->ts); gfc_mark_ss_chain_used (rss, 1); /* Start the loop body. */ @@ -4677,7 +4694,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_conv_resolve_dependencies (&loop, lss_section, rss); /* Setup the scalarizing loops. */ - gfc_conv_loop_setup (&loop, &expr2->where); + gfc_conv_loop_setup (&loop, &expr2->where, &expr2->ts); /* Setup the gfc_se structures. */ gfc_copy_loopinfo_to_se (&lse, &loop); @@ -5128,7 +5145,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock) } gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &tdst->where); + gfc_conv_loop_setup (&loop, &tdst->where, &tdst->ts); gfc_mark_ss_chain_used (css, 1); gfc_mark_ss_chain_used (tdss, 1); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 6a89b30e3bf..89850be5ac6 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see #include "toplev.h" /* For rest_of_decl_compilation. */ #include "trans-types.h" #include "trans-const.h" +#include "trans-array.h" #include "dwarf2out.h" /* For struct array_descr_info. */ @@ -68,7 +69,6 @@ tree gfc_complex_float128_type_node = NULL_TREE; bool gfc_real16_is_float128 = false; static GTY(()) tree gfc_desc_dim_type; -static GTY(()) tree gfc_max_array_element_size; static GTY(()) tree gfc_array_descriptor_base[2 * (GFC_MAX_DIMENSIONS+1)]; static GTY(()) tree gfc_array_descriptor_base_caf[2 * (GFC_MAX_DIMENSIONS+1)]; @@ -864,7 +864,6 @@ gfc_init_types (void) char name_buf[18]; int index; tree type; - unsigned n; /* Create and name the types. */ #define PUSH_TYPE(name, node) \ @@ -951,16 +950,6 @@ gfc_init_types (void) build_int_cst (gfc_array_index_type, 0), NULL_TREE); - /* The maximum array element size that can be handled is determined - 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, - TYPE_PRECISION (size_type_node))); - boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind); boolean_true_node = build_int_cst (boolean_type_node, 1); boolean_false_node = build_int_cst (boolean_type_node, 0); @@ -1199,21 +1188,25 @@ gfc_get_element_type (tree type) /* Build an array. This function is called from gfc_sym_type(). Actually returns array descriptor type. - Format of array descriptors is as follows: + Format of array descriptors is as follows, cf. TS29113:2012. struct gfc_array_descriptor { - array *data - index offset; - index dtype; - struct descriptor_dimension dimension[N_DIM]; + base_type *base_addr; + size_t elem_len; + int version; + int8_t rank; + int8_t attribute; + int16_t type; + ptrdiff_t offset; + struct CFI_dim_t dim[N_DIM]; } - struct descriptor_dimension + struct CFI_dim_t { - index stride; - index lbound; - index ubound; + ptrdiff_t lower_bound; + ptrdiff_t extent; + ptrdiff_t sm; } Translation code should use gfc_conv_descriptor_* rather than @@ -1225,10 +1218,10 @@ 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 + The type member is formatted as follows; the lower byte contains + the type, the upper byte contains the kind value. + data_type = (type & GFC_TYPE_MASK) + kind = (type >> GFC_TYPE_KIND_SHIFT) I originally used nested ARRAY_TYPE nodes to represent arrays, but this generated poor code for assumed/deferred size arrays. These @@ -1381,19 +1374,19 @@ gfc_get_desc_dim_type (void) TYPE_NAME (type) = get_identifier ("descriptor_dimension"); TYPE_PACKED (type) = 1; - /* Consists of the stride, lbound and ubound members. */ + /* Consists of the lower_bound, extent and stride-multiplier members. */ decl = gfc_add_field_to_struct_1 (type, - get_identifier ("stride"), + get_identifier ("lower_bound"), gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; decl = gfc_add_field_to_struct_1 (type, - get_identifier ("lbound"), + get_identifier ("extent"), gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; decl = gfc_add_field_to_struct_1 (type, - get_identifier ("ubound"), + get_identifier ("sm"), gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; @@ -1412,100 +1405,44 @@ gfc_get_desc_dim_type (void) unknown cases abort. */ tree -gfc_get_dtype_rank_type (int rank, tree etype) +gfc_get_dtype (gfc_typespec *ts) { - tree size; - int n; - HOST_WIDE_INT i; - tree tmp; - tree dtype; + int type; + tree int16_type_node + = gfc_get_int_type (gfc_get_int_kind_from_width_isofortranenv (16)); - switch (TREE_CODE (etype)) + switch (ts->type) { - case INTEGER_TYPE: - n = BT_INTEGER; - break; - - case BOOLEAN_TYPE: - n = BT_LOGICAL; + case BT_INTEGER: + type = GFC_TYPE_INTEGER + (ts->kind << GFC_TYPE_KIND_SHIFT); break; - - case REAL_TYPE: - n = BT_REAL; + case BT_LOGICAL: + type = GFC_TYPE_LOGICAL + (ts->kind << GFC_TYPE_KIND_SHIFT); break; - - case COMPLEX_TYPE: - n = BT_COMPLEX; + case BT_REAL: + type = GFC_TYPE_REAL + (ts->kind << GFC_TYPE_KIND_SHIFT); break; - - /* We will never have arrays of arrays. */ - case RECORD_TYPE: - n = BT_DERIVED; + case BT_COMPLEX: + type = GFC_TYPE_COMPLEX + (ts->kind << GFC_TYPE_KIND_SHIFT); break; - - case ARRAY_TYPE: - n = BT_CHARACTER; + case BT_CHARACTER: + type = GFC_TYPE_CHARACTER + (ts->kind << GFC_TYPE_KIND_SHIFT); break; - - case POINTER_TYPE: - n = BT_ASSUMED; + case BT_DERIVED: + if (ts->f90_type == BT_VOID) + type = ts->u.derived + && ts->u.derived->intmod_sym_id == ISOCBINDING_PTR + ? GFC_TYPE_CFUNPTR : GFC_TYPE_CPTR; + else if (ts->u.derived->attr.sequence || ts->u.derived->attr.is_bind_c) + type = GFC_TYPE_STRUCT; + else + type = GFC_TYPE_OTHER; break; - default: - /* TODO: Don't do dtype for temporary descriptorless arrays. */ - /* We can strange array types for temporary arrays. */ - 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; + type = GFC_TYPE_OTHER; } - 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; -} - - -tree -gfc_get_dtype (tree type) -{ - tree dtype; - tree etype; - int rank; - - gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type)); - - if (GFC_TYPE_ARRAY_DTYPE (type)) - return GFC_TYPE_ARRAY_DTYPE (type); - - rank = GFC_TYPE_ARRAY_RANK (type); - etype = gfc_get_element_type (type); - dtype = gfc_get_dtype_rank_type (rank, etype); - - GFC_TYPE_ARRAY_DTYPE (type) = dtype; - return dtype; + return build_int_cst (int16_type_node, type); } @@ -1727,9 +1664,15 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted, enum gfc_array_kind akind) { tree fat_type, decl, arraytype, *chain = NULL; + tree int8_type_node, int16_type_node; char name[16 + 2*GFC_RANK_DIGITS + 1 + 1]; int idx; + int8_type_node + = gfc_get_int_type (gfc_get_int_kind_from_width_isofortranenv (8)); + int16_type_node + = gfc_get_int_type (gfc_get_int_kind_from_width_isofortranenv (16)); + /* Assumed-rank array. */ if (dimen == -1) dimen = GFC_MAX_DIMENSIONS; @@ -1755,20 +1698,44 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted, /* Add the data member as the first element of the descriptor. */ decl = gfc_add_field_to_struct_1 (fat_type, - get_identifier ("data"), + get_identifier ("base_addr"), (restricted ? prvoid_type_node : ptr_type_node), &chain); - /* Add the base component. */ + /* Add the elem_len component. */ decl = gfc_add_field_to_struct_1 (fat_type, - get_identifier ("offset"), - gfc_array_index_type, &chain); + get_identifier ("elem_len"), + size_type_node, &chain); + TREE_NO_WARNING (decl) = 1; + + /* Add the version component. */ + decl = gfc_add_field_to_struct_1 (fat_type, + get_identifier ("version"), + integer_type_node, &chain); + TREE_NO_WARNING (decl) = 1; + + /* Add the rank component. */ + decl = gfc_add_field_to_struct_1 (fat_type, + get_identifier ("rank"), + int8_type_node, &chain); + TREE_NO_WARNING (decl) = 1; + + /* Add the attribute component. */ + decl = gfc_add_field_to_struct_1 (fat_type, + get_identifier ("attribute"), + int8_type_node, &chain); TREE_NO_WARNING (decl) = 1; - /* Add the dtype component. */ + /* Add the type component. */ decl = gfc_add_field_to_struct_1 (fat_type, - get_identifier ("dtype"), + get_identifier ("type"), + int16_type_node, &chain); + TREE_NO_WARNING (decl) = 1; + + /* Add the offset component. */ + decl = gfc_add_field_to_struct_1 (fat_type, + get_identifier ("offset"), gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; @@ -3112,6 +3079,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) tree etype, ptype, field, t, base_decl; tree data_off, dim_off, dim_size, elem_size; tree lower_suboff, upper_suboff, stride_suboff; + tree type_fields; if (! GFC_DESCRIPTOR_TYPE_P (type)) { @@ -3170,11 +3138,10 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) elem_size = GFC_TYPE_ARRAY_SPAN (type); else elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype)); - field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type)); + type_fields = TYPE_FIELDS (TYPE_MAIN_VARIANT (type)); + field = gfc_data_field_from_base_field (type_fields); data_off = byte_position (field); - field = DECL_CHAIN (field); - field = DECL_CHAIN (field); - field = DECL_CHAIN (field); + field = gfc_dimension_field_from_base_field (type_fields); dim_off = byte_position (field); dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (field))); field = TYPE_FIELDS (TREE_TYPE (TREE_TYPE (field))); diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index c518cc18926..270b7a31d79 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -97,8 +97,7 @@ int gfc_return_by_reference (gfc_symbol *); int gfc_is_nodesc_array (gfc_symbol *); /* Return the DTYPE for an array. */ -tree gfc_get_dtype_rank_type (int, tree); -tree gfc_get_dtype (tree); +tree gfc_get_dtype (gfc_typespec *); tree gfc_get_ppc_type (gfc_component *); tree gfc_get_caf_vector_type (int dim); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 28d1341cc7e..62c4f158378 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -935,7 +935,7 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var, to zero. */ gfc_clear_attr (&attr); gfc_init_se (&se, NULL); - array = gfc_conv_scalar_to_descriptor (&se, array, attr); + array = gfc_conv_scalar_to_descriptor (&se, array, attr, &var->ts); gcc_assert (se.post.head == NULL_TREE); } } @@ -976,7 +976,7 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var, to zero. */ gfc_clear_attr (&attr); gfc_init_se (&se, NULL); - array = gfc_conv_scalar_to_descriptor (&se, array, attr); + array = gfc_conv_scalar_to_descriptor (&se, array, attr, &var->ts); } gcc_assert (se.post.head == NULL_TREE); } @@ -1057,7 +1057,7 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp, { gfc_clear_attr (&attr); gfc_init_se (&se, NULL); - array = gfc_conv_scalar_to_descriptor (&se, array, attr); + array = gfc_conv_scalar_to_descriptor (&se, array, attr, &comp->ts); gfc_add_block_to_block (&block2, &se.pre); gcc_assert (se.post.head == NULL_TREE); } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 512615ab1e4..d1cdbaccc0a 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -441,7 +441,11 @@ void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr); void gfc_conv_expr_reference (gfc_se * se, gfc_expr *); void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree); -tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute); +tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute, + gfc_typespec *); + +/* Termine the byte-size of a string. */ +tree size_of_string_in_bytes (int, tree); /* trans-expr.c */ @@ -565,7 +569,8 @@ bool gfc_get_module_backend_decl (gfc_symbol *); tree gfc_get_symbol_decl (gfc_symbol *); /* Build a static initializer. */ -tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, bool); +tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, + bool, int); /* Assign a default initializer to a derived type. */ void gfc_init_default_dt (gfc_symbol *, stmtblock_t *, bool); diff --git a/gcc/testsuite/ChangeLog.fortran-dev b/gcc/testsuite/ChangeLog.fortran-dev new file mode 100644 index 00000000000..f394be14306 --- /dev/null +++ b/gcc/testsuite/ChangeLog.fortran-dev @@ -0,0 +1,129 @@ +2016-09-07 Dominique Dhumieres <dominiq@lps.ens.fr> + + PR fortran/48298 + * gfortran.dg/assumed_rank_12.f90: Correct tree scan. + * gfortran.dg/assumed_type_2.f90: Correct tree scans. + * gfortran.dg/coarray_lib_comm_1.f90: Likewise. + * gfortran.dg/coarray_lib_this_image_2.f90: Likewise. + * gfortran.dg/coarray_lock_7.f90: Likewise. + * gfortran.dg/coarray_stat_function.f90: Likewise. + * gfortran.dg/no_arg_check_2.f90: Likewise. + * gfortran.dg/pr32921.f: Likewise. + +2016-09-07 Paul Thomas <pault@gcc.gnu.org> + + * gfortran.dg/array_section_2.f90: Remove invocation of cleanup + tree dump. + * gfortran.dg/class_allocate_14.f90: Likewise. + * gfortran.dg/iso-ts-29113_2.f90: Likewise. + * gfortran.dg/pr32921.f: Likewise. + +2014-06-03 Paul Thomas <pault@gcc.gnu.org> + + * gfortran.dg/pr48636.f90 : Change the expected numbers of + 'phi predicate' predicate from 5 to 7. + * gfortran.dg/assign_10.f90 : Change the expected numbers of + 'parm' predicate from 32 to 30. + * gfortran.dg/transpose_optimization_2.f90 : Change the + expected numbers of 'parm' predicate from 102 to 90. + +2014-05-24 Dominique d'Humieres <dominiq@lps.ens.fr> + + * ChangeLog: Remove missing changes. + * gfortran.dg/coarray_12.f90: Adjust regexps. + * gfortran.dg/coarray_31.f90: Likewise. + * gfortran.dg/coarray_lib_alloc_2.f90: Likewise. + +2014-05-24 Dominique d'Humieres <dominiq@lps.ens.fr> + + * gfortran.dg/assign_10.f90: Adjust regexps. + * gfortran.dg/assumed_rank_12.f90: Likewise. + * gfortran.dg/coarray_lib_alloc_3.f90: Likewise. + * gfortran.dg/coarray_lib_this_image_1.f90: Likewise. + * gfortran.dg/coarray_lib_this_image_2.f90: Likewise. + * gfortran.dg/coarray_lib_token_4.f90: Likewise. + * gfortran.dg/coarray_poly_5.f90: Likewise. + * gfortran.dg/coarray_poly_6.f90: Likewise. + * gfortran.dg/coarray_poly_7.f90: Likewise. + * gfortran.dg/coarray_poly_8.f90: Likewise. + * gfortran.dg/contiguous_3.f90: Likewise. + * gfortran.dg/finalize_10.f90: Likewise. + * gfortran.dg/finalize_18.f90: Likewise. + * gfortran.dg/realloc_on_assign_18.f90: Likewise. + * gfortran.dg/transpose_optimization_2.f90: Likewise. + +2013-06-03 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/assumed_rank_14.f90: Renamed from assumed_rank_13.f90. + +2013-05-06 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/assumed_rank_13.f90: New. + * gfortran.dg/array_section_2.f90: Remove tree-dump check. + * gfortran.dg/assign_10.f90: Update dump-times. + * gfortran.dg/transpose_optimization_2.f90: Ditto. + * gfortran.dg/coarray_12.f90: Update dump pattern. + * gfortran.dg/coarray_30.f90: Ditto. + * gfortran.dg/intrinsic_size_3.f90: Ditto. + +2013-05-02 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/iso-ts-29113_2.f90: Update scan-dump. + +2013-04-30 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/iso-ts-29113_2.f90: New. + * gfortran.dg/iso-ts-29113_1_c.c: Enable type check. + * gfortran.dg/assumed_rank_12.f90: Update scan-dump. + * gfortran.dg/c_loc_test_22.f90: Ditto. + * gfortran.dg/class_allocate_14.f90: Ditto. + +2013-04-25 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/assign_10.f90: Update scan dump times. + * gfortran.dg/associate_11.f90: Ditto. + * gfortran.dg/assumed_rank_10.f90: Ditto. + * gfortran.dg/assumed_rank_12.f90: Ditto. + * gfortran.dg/assumed_type_2.f90: Ditto. + * gfortran.dg/class_allocate_14.f90: Ditto. + * gfortran.dg/intrinsic_size_3.f90: Ditto. + * gfortran.dg/no_arg_check_2.f90: Ditto. + * gfortran.dg/transpose_optimization_2.f90: Ditto. + * gfortran.dg/iso-ts-29113_1.f90: New. + * gfortran.dg/iso-ts-29113_1_c.c: New. + +2013-03-31 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/c_f_pointer_tests.f90: Move to trunk version. + +2012-07-20 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/c_f_pointer_tests_3.f90: Update scan-tree-dump + pattern. + +2012-07-15 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/array_section_2.f90: Update scan-tree-dump pattern. + +2012-03-12 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/assign_10.f90: Update scan-tree-dump-times. + * gfortran.dg/internal_pack_4.f90: Ditto. + +2012-03-12 Tobias Burnus <burnus@net-b.de> + + * assumed_type_2.f90: Change "data" to "base_addr" in + scan-tree-dump. + * block_2.f08: Ditto. + * coarray_lib_token_2.f90: Ditto. + * coarray_lib_token_3.f90: Ditto. + * coarray_lib_token_4.f90: Ditto. + * pr43984.f90: Ditto. + +2012-03-12 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/coarray_12.f90: Update scan-tree-dump-times. + * gfortran.dg/contiguous_3.f90: Ditto. + * gfortran.dg/array_section_2.f90: Ditto. + * gfortran.dg/transpose_optimization_2.f90: Ditto. + * gfortran.dg/pr32921.f: Ditto. diff --git a/gcc/testsuite/gfortran.dg/array_section_2.f90 b/gcc/testsuite/gfortran.dg/array_section_2.f90 index 272f0e5834e..dab735bc907 100644 --- a/gcc/testsuite/gfortran.dg/array_section_2.f90 +++ b/gcc/testsuite/gfortran.dg/array_section_2.f90 @@ -1,11 +1,14 @@ ! { dg-do compile } -! { dg-options "-fdump-tree-original" } ! ! PR38033 - size(a) was not stabilized correctly and so the expression was ! evaluated twice outside the loop and then within the scalarization loops. ! ! Contributed by Thomas Bruel <tmbdev@gmail.com> ! +! Note: With the new array descriptor, which uses extent directly and inlined +! SIZE, this is no longer simply testable in the dump. +! (Before, the code had a -fdump-tree-original check.) +! program test integer, parameter :: n = 100 real, pointer :: a(:),temp(:) ! pointer or allocatable have the same effect diff --git a/gcc/testsuite/gfortran.dg/assign_10.f90 b/gcc/testsuite/gfortran.dg/assign_10.f90 index 58124b69b78..1d006610721 100644 --- a/gcc/testsuite/gfortran.dg/assign_10.f90 +++ b/gcc/testsuite/gfortran.dg/assign_10.f90 @@ -1,5 +1,5 @@ ! { dg-do run } -! { dg-options "-O3 -fdump-tree-original" } +! { dg-options "-fdump-tree-original" } ! Tests the fix for PR33850, in which one of the two assignments ! below would produce an unnecessary temporary for the index ! expression, following the fix for PR33749. @@ -23,5 +23,5 @@ end ! cases will all yield a temporary, so that atmp appears 18 times. ! Note that it is the kind conversion that generates the temp. ! -! { dg-final { scan-tree-dump-times "parm" 18 "original" } } -! { dg-final { scan-tree-dump-times "atmp" 18 "original" } } +! { dg-final { scan-tree-dump-times "parm" 30 "original" } } +! { dg-final { scan-tree-dump-times "atmp" 26 "original" } } diff --git a/gcc/testsuite/gfortran.dg/associate_11.f90 b/gcc/testsuite/gfortran.dg/associate_11.f90 index 3ef31f48fa1..d640ad0a2d0 100644 --- a/gcc/testsuite/gfortran.dg/associate_11.f90 +++ b/gcc/testsuite/gfortran.dg/associate_11.f90 @@ -21,4 +21,4 @@ contains end subroutine foo end program bug -! { dg-final { scan-tree-dump-times "foo ..integer.kind=4..0:. . restrict. a.data.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo ..integer.kind=4..0:. . restrict. a.base_addr.;" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_10.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_10.f90 index 4a6b9088de0..d1f04e0dbfa 100644 --- a/gcc/testsuite/gfortran.dg/assumed_rank_10.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_rank_10.f90 @@ -99,7 +99,7 @@ end program test ! We should have exactly one copy back per variable ! -! { dg-final { scan-tree-dump-times "iip = .integer.kind=4. .. desc.\[0-9\]+.data;" 1 "original" } } -! { dg-final { scan-tree-dump-times "iia = .integer.kind=4. .. desc.\[0-9\]+.data;" 1 "original" } } -! { dg-final { scan-tree-dump-times "jjp = .struct t .. desc.\[0-9\]+.data;" 1 "original" } } -! { dg-final { scan-tree-dump-times "jja = .struct t .. desc.\[0-9\]+.data;" 1 "original" } } +! { dg-final { scan-tree-dump-times "iip = .integer.kind=4. .. desc.\[0-9\]+.base_addr;" 1 "original" } } +! { dg-final { scan-tree-dump-times "iia = .integer.kind=4. .. desc.\[0-9\]+.base_addr;" 1 "original" } } +! { dg-final { scan-tree-dump-times "jjp = .struct t .. desc.\[0-9\]+.base_addr;" 1 "original" } } +! { dg-final { scan-tree-dump-times "jja = .struct t .. desc.\[0-9\]+.base_addr;" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90 index 873498f82d7..840ab0ddc37 100644 --- a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90 @@ -16,5 +16,4 @@ function f() result(res) end function f end -! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.dtype = .*;.*desc.0.data = .void .. D.*;.*sub \\(&desc.0\\);.*D.*= .integer.kind=4. .. desc.0.data;" "original" } } - +! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.type = 1025;.*desc.0.base_addr = .void .. D.\[0-9\]+;.*desc.0.elem_len = 4;.*desc.0.version = 1;.*desc.0.rank = 0;.*desc.0.attribute = 1;.*sub \\(&desc.0\\);.*D.\[0-9\]+ = .integer.kind=4. .. desc.0.base_addr;" "original" } } diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_14.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_14.f90 new file mode 100644 index 00000000000..2b928e0c281 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_rank_14.f90 @@ -0,0 +1,40 @@ +! { dg-do run } +! +! Ensure that SIZE/SHAPE/UBOUND/LBOUND work properly with +! assumed-rank arrays for scalars and assumed-size arrays +! +program main + implicit none + integer :: A(2,2) + integer :: B + call foo(A) + call test2(B) +contains + subroutine foo(x) + integer :: x(2,*) + call bar(x) + end subroutine foo + subroutine bar(y) + integer :: y(..) +! print *, rank(y) ! 2 +! print *, lbound(y) ! 1 1 +! print *, ubound(y) ! 2 -1 +! print *, shape(y) ! 2 -1 +! print *, size(y) ! -2 + if (rank(y) /= 2) call abort () + if (any (lbound(y) /= [1, 1])) call abort + if (any (ubound(y) /= [2,-1])) call abort + if (any (shape(y) /= [2,-1])) call abort + if (size(y,1) /= 2) call abort + if (size(y,2) /= -1) call abort + if (size(y) /= -2) call abort + end subroutine bar + subroutine test2(z) + integer :: z(..) + if (rank(z) /= 0) call abort() ! 1 + if (size(lbound(z)) /= 0) call abort() ! zero-sized array + if (size(ubound(z)) /= 0) call abort() ! zero-sized array + if (size(shape(z)) /= 0) call abort() ! zero-sized array + if (size(z) /= 1) call abort() ! 1 + end subroutine test2 +end program main diff --git a/gcc/testsuite/gfortran.dg/assumed_type_2.f90 b/gcc/testsuite/gfortran.dg/assumed_type_2.f90 index f1a20747884..9a3388f3f3a 100644 --- a/gcc/testsuite/gfortran.dg/assumed_type_2.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_type_2.f90 @@ -150,23 +150,24 @@ end ! { dg-final { scan-tree-dump-times "sub_scalar .&array_int.1.," 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(character.kind=1..0:..1:1. .\\) array_char_ptr.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t3.0:. .\\) array_t3_ptr.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) \\(array_class_t1_ptr._data.dat" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(character.kind=1..0:..1:1. .\\) array_char_ptr.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t3.0:. .\\) array_t3_ptr.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) \\(array_class_t1_ptr._data.base_addr" 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 3 "original" } } ! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&parm" 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(&array_int\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.data" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.base_addr" 1 "original" } } ! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&array_char_ptr\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "\\.data = \\(void .\\) &array_t1.0.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "\\.base_addr = \\(void .\\) &array_t1.0.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) parm" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.data\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.data\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.data\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.base_addr\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = _gfortran_internal_pack \\(&array_t3_ptr\\);\[^\\n\]*\\n *sub_array_assumed \\(D\\.\[0-9\]+\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.base_addr\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.base_addr\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_real_alloc," 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_char_ptr," 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/block_2.f08 b/gcc/testsuite/gfortran.dg/block_2.f08 index a2ba2d5caea..8c0e15e1f25 100644 --- a/gcc/testsuite/gfortran.dg/block_2.f08 +++ b/gcc/testsuite/gfortran.dg/block_2.f08 @@ -35,4 +35,4 @@ PROGRAM main IF (str /= "12345") CALL abort () END BLOCK END PROGRAM main -! { dg-final { scan-tree-dump-times "free \\(\\(void \\*\\) alloc_arr\\.data" 1 "original" } } +! { dg-final { scan-tree-dump-times "free \\(\\(void \\*\\) alloc_arr\\.base_addr" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 index ece08339990..aa0b5479682 100644 --- a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 +++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 @@ -31,10 +31,10 @@ end program test ! ! Array c_f_pointer: ! -! { dg-final { scan-tree-dump-times " fptr_array.data = cptr;" 1 "original" } } -! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].ubound = " 1 "original" } } -! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].stride = " 1 "original" } } +! { dg-final { scan-tree-dump-times " fptr_array.base_addr = cptr;" 1 "original" } } +! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].extent = " 1 "original" } } +! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].sm = " 1 "original" } } ! ! Check c_f_procpointer ! { dg-final { scan-tree-dump-times " fprocptr = .integer.kind=4. .\\*<.*>. ... cfunptr;" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 index 5f4f9775b4a..aa1c29f1853 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 +++ b/gcc/testsuite/gfortran.dg/c_loc_test_22.f90 @@ -15,9 +15,9 @@ subroutine sub(xxx, yyy) ptr4 = c_loc (yyy(5:)) end ! { dg-final { scan-tree-dump-not " _gfortran_internal_pack" "original" } } -! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } -! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } } -! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } -! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } } +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.xxx.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } } +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void .\\) &\\(.yyy.\[0-9\]+\\)\\\[D.\[0-9\]+ \\* 4\\\];" 1 "original" } } -! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = parm.\[0-9\]+.data;\[^;]+ptr\[1-4\] = D.\[0-9\]+;" 4 "original" } } +! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = parm.\[0-9\]+.base_addr;\[^;]+ptr\[1-4\] = D.\[0-9\]+;" 4 "original" } } diff --git a/gcc/testsuite/gfortran.dg/class_allocate_14.f90 b/gcc/testsuite/gfortran.dg/class_allocate_14.f90 index 0eed2bd3c85..99afd05c668 100644 --- a/gcc/testsuite/gfortran.dg/class_allocate_14.f90 +++ b/gcc/testsuite/gfortran.dg/class_allocate_14.f90 @@ -25,6 +25,5 @@ call sub() call sub2() end -! { dg-final { scan-tree-dump-times "static struct __class_m_T_1_0a b = {._data={.data=0B}, ._vptr=&__vtab_m_T};" 1 "original" } } +! { dg-final { scan-tree-dump-times "static struct __class_m_T_1_0a b = {._data={.base_addr=0B, .elem_len=4, .version=1, .rank=1, .attribute=2, .type=-1}, ._vptr=&__vtab_m_T};" 1 "original" } } ! { dg-final { scan-tree-dump-times "static struct __class_m_T_a y = {._data=0B, ._vptr=&__vtab_m_T};" 1 "original" } } - diff --git a/gcc/testsuite/gfortran.dg/coarray_12.f90 b/gcc/testsuite/gfortran.dg/coarray_12.f90 index 70efaaff516..d9a4091e149 100644 --- a/gcc/testsuite/gfortran.dg/coarray_12.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_12.f90 @@ -45,32 +45,32 @@ subroutine testAlloc5() end subroutine testAlloc5 -! { dg-final { scan-tree-dump-times "a.dim.0..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "a.dim.0..ubound = .*nn;" 1 "original" } } -! { dg-final { scan-tree-dump-times "a.dim.1..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "a.dim.1..ubound = .*mm;" 1 "original" } } -! { dg-final { scan-tree-dump-times "a.dim.2..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "a.dim.2..ubound" 0 "original" } } +! { dg-final { scan-tree-dump-times "a.dim.0..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "a.dim.0..extent = MAX_EXPR <.*nn.*, 0>;" 1 "original" } } +! { dg-final { scan-tree-dump-times "a.dim.1..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "a.dim.1..extent = .*mm - a.dim.1..lower_bound. \\+ 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "a.dim.2..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "a.dim.2..extent" 0 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.0..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.0..ubound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.1..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.1..ubound = 7;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.2..lbound = -5;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.2..ubound = 8;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.3..lbound = .*mmm;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.3..ubound = 2;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.4..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "xxx.dim.4..ubound" 0 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.0..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.0..extent = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.1..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.1..extent = 8 - xxx.dim.1..lower_bound;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.2..lower_bound = -5;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.2..extent = 9 - xxx.dim.2..lower_bound;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.3..lower_bound = .*mmm;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.3..extent = 3 - xxx.dim.3..lower_bound;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.4..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "xxx.dim.4..extent" 0 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.0..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.0..ubound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.1..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.1..ubound = 7;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.2..lbound = -5;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.2..ubound = .*ppp;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.3..lbound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.3..ubound = 1;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.4..lbound = .*ooo;" 1 "original" } } -! { dg-final { scan-tree-dump-times "yyy.dim.4..ubound" 0 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.0..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.0..extent = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.1..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.1..extent = 8 - yyy.dim.1..lower_bound;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.2..lower_bound = -5;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.2..extent = .*ppp - yyy.dim.2..lower_bound. \\+ 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.3..lower_bound = 1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.3..extent = 2 - yyy.dim.3..lower_bound;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.4..lower_bound = .*ooo;" 1 "original" } } +! { dg-final { scan-tree-dump-times "yyy.dim.4..extent" 0 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_18.f90 b/gcc/testsuite/gfortran.dg/coarray_18.f90 index 474e9391edb..18a0fb86227 100644 --- a/gcc/testsuite/gfortran.dg/coarray_18.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_18.f90 @@ -19,14 +19,17 @@ 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" } + 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 :: i2(2,2,2,2,2,2,2)[2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 15 dimensions" } + 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,*] + integer :: ip[2,2,2,2,2,2,2,2,2,2,2,2,2,2,*] + integer :: ip[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,*] diff --git a/gcc/testsuite/gfortran.dg/coarray_30.f90 b/gcc/testsuite/gfortran.dg/coarray_30.f90 index d68bcccf794..71ddf764640 100644 --- a/gcc/testsuite/gfortran.dg/coarray_30.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_30.f90 @@ -11,4 +11,4 @@ program main write(greeting,"(a)") "z" end -! { dg-final { scan-tree-dump-times "greeting.data = \\(void . restrict\\) __builtin_malloc \\(25\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "greeting.base_addr = \\(void . restrict\\) __builtin_malloc \\(25\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_31.f90 b/gcc/testsuite/gfortran.dg/coarray_31.f90 index 0da4d90ce14..c08c564c1fe 100644 --- a/gcc/testsuite/gfortran.dg/coarray_31.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_31.f90 @@ -16,6 +16,6 @@ type(t2) :: a, b a = b end -! { dg-final { scan-tree-dump "a.y.x.data = D.\[0-9\]+.y.x.data;" "original" } } -! { dg-final { scan-tree-dump "a.y.z._data.data = D.\[0-9\]+.y.z._data.data;" "original" } } -! { dg-final { scan-tree-dump "a.y.d._data.data = D.\[0-9\]+.y.d._data.data;" "original" } } +! { dg-final { scan-tree-dump "a.y.x.base_addr = D.\[0-9\]+.y.x.base_addr;" "original" } } +! { dg-final { scan-tree-dump "a.y.z._data.base_addr = D.\[0-9\]+.y.z._data.base_addr;" "original" } } +! { dg-final { scan-tree-dump "a.y.d._data.base_addr = D.\[0-9\]+.y.d._data.base_addr;" "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 index 19c60a0b59c..9110e634924 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 @@ -15,8 +15,8 @@ deallocate(xx,yy,stat=stat, errmsg=errmsg) end -! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump "_gfortran_caf_register .(40|72), 1, &xx._data.token, &stat.., &errmsg, 200.;" "original" } } +! { dg-final { scan-tree-dump "_gfortran_caf_register .(104|192), 1, &yy._data.token, &stat.., &errmsg, 200.;" "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 index 696c937e600..63144cbd7df 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 @@ -16,8 +16,8 @@ subroutine test deallocate(xx,yy,stat=stat, errmsg=errmsg) end -! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump "_gfortran_caf_register .(40|72), 1, &xx._data.token, &stat.., &errmsg, 200.;" "original" } } +! { dg-final { scan-tree-dump "_gfortran_caf_register .(104|192), 1, &yy._data.token, &stat.., &errmsg, 200.;" "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 index 7b4d9375de5..a56ea2cd3b6 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 @@ -38,8 +38,8 @@ B(1:5) = B(3:7) if (any (A-B /= 0)) call abort end -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0, 0B\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1, 0B\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1, 0B\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0, 0B\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0, 0B\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1, 0B\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1, 0B\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0, 0B\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0\\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 index 63cca3e32c7..10c1530a130 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 @@ -18,8 +18,8 @@ end ! { dg-final { scan-tree-dump-times "bar \\(real\\(kind=4\\)\\\[2\\\] \\* 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" } } +! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lower_bound = 5;" 1 "original" } } +! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lower_bound \\+ \[^\n\r]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } } ! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(x, caf_token.., 0\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 index 196a2d3b93e..0eeaed26e09 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 @@ -16,11 +16,11 @@ 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" } } +! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lower_bound = 5;" 1 "original" } } +! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lower_bound \\+ \[^\n\r\]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } } ! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=\[48\]\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=\[48\]\\)\\) x\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=\[48\]\\)\\) parm.\[0-9\]+.base_addr - \\(integer\\(kind=\[48\]\\)\\) x\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 index b408529184b..08165056cc7 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 @@ -93,10 +93,10 @@ end program main ! ! CALL 1 ! -! sub ((integer(kind=4) *) caf.data, &((struct t * restrict) caf_dt.data)->b, +! sub ((integer(kind=4) *) caf.base_addr, &((struct t * restrict) caf_dt.base_addr)->b, ! caf.token, 0, caf_dt.token, 4); ! -! { dg-final { scan-tree-dump-times "sub \\(\[^,\]*caf.data, &\[^,\]*caf_dt.data.->b, caf.token, 0, caf_dt.token, 4\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub \\(\[^,\]*caf.base_addr, &\[^,\]*caf_dt.base_addr.->b, caf.token, 0, caf_dt.token, 4\\)" 1 "original" } } ! ! sub2 ((integer(kind=4) *) x1, (integer(kind=4) *) x2, ! caf_token.4, NON_LVALUE_EXPR <caf_offset.5>, @@ -110,5 +110,5 @@ end program main ! ! CALL 4 ! -! { dg-final { scan-tree-dump-times "sub_opt \\(.integer.kind=4. .. caf.data, caf.token, 0\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_opt \\(.integer.kind=4. .. caf.base_addr, caf.token, 0\\)" 1 "original" } } ! diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 index 1a92f02d48a..aaeb8108d22 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 @@ -8,5 +8,5 @@ allocate(CAF(1)[*]) allocate(CAF_SCALAR[*]) end -! { dg-final { scan-tree-dump-times "caf.data = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf.token, 0B, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "caf_scalar.data = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf_scalar.token, 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "caf.base_addr = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf.token, 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "caf_scalar.base_addr = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf_scalar.token, 0B, 0B, 0\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 index 8183140bd93..189a56c6539 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 @@ -35,17 +35,17 @@ 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" } } +! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.base_addr - \\(integer\\(kind=.\\)\\) x.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 1 "original" } } ! -! { dg-final { scan-tree-dump-times "expl \\(\\(integer\\(kind=4\\).0:. .\\) parm.\[0-9\]+.data, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(\\(integer\\(kind=.\\)\\) y.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 0 "original" } } +! { dg-final { scan-tree-dump-times "expl \\(\\(integer\\(kind=4\\).0:. .\\) parm.\[0-9\]+.base_addr, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.base_addr - \\(\\(integer\\(kind=.\\)\\) y.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 0 "original" } } ! ! { dg-final { scan-tree-dump-times "foo \\(&a, &a, &C.\[0-9\]+, a.token, 0, a.token, 0\\);" 1 "original" } } ! -! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &parm.\[0-9\]+, &C.\[0-9\]+, a.token, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) a.data, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) b\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &parm.\[0-9\]+, &C.\[0-9\]+, a.token, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.base_addr - \\(integer\\(kind=.\\)\\) a.base_addr, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.base_addr - \\(integer\\(kind=.\\)\\) b\\);" 1 "original" } } ! -! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &a, &C.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) b, a.token, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &a, &C.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.base_addr - \\(integer\\(kind=.\\)\\) b, a.token, 0\\);" 1 "original" } } ! diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_7.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_7.f90 index b8920f1240d..8840189f8e4 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lock_7.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lock_7.f90 @@ -29,18 +29,18 @@ end ! { dg-final { scan-tree-dump-times "one = \\(void \\* \\* restrict\\) _gfortran_caf_register \\(1, 2, \\(void \\* \\*\\) &caf_token.., 0B, 0B, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "two = \\(void \\*\\\[25\\\] \\* restrict\\) _gfortran_caf_register \\(25, 2, \\(void \\* \\*\\) &caf_token.., 0B, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "three.data = \\(void \\* restrict\\) _gfortran_caf_register \\(1, 3, &three.token, &stat.., 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "four.data = \\(void \\* restrict\\) _gfortran_caf_register \\(7, 3, &four.token, &stat.., 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "three.base_addr = \\(void \\* restrict\\) _gfortran_caf_register \\(1, 3, &three.token, &stat.., 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "four.base_addr = \\(void \\* restrict\\) _gfortran_caf_register \\(7, 3, &four.token, &stat.., 0B, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., 0, 0, 0B, 0B, 0B, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., 0, 0, 0B, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lbound\\) \\+ \\(integer\\(kind=4\\)\\) MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[1\\\].lbound\\), 0, 0B, &ii, 0B, 0\\);|_gfortran_caf_lock \\(caf_token.1, \\(3 - parm...dim\\\[0\\\].lbound\\) \\+ MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - parm...dim\\\[1\\\].lbound\\), 0, 0B, &ii, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., \\(2 - \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lbound\\) \\+ \\(integer\\(kind=4\\)\\) MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[1\\\].lbound\\), 0, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(caf_token.., \\(2 - parm...dim\\\[0\\\].lbound\\) \\+ MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - parm...dim\\\[1\\\].lbound\\), 0, &ii, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lower_bound\\) \\+ \\(integer\\(kind=4\\)\\) MAX_EXPR <\\(\\(\\(parm...dim\\\[0\\\].lower_bound \\+ parm...dim\\\[0\\\].extent\\) \\+ -1\\) - parm...dim\\\[0\\\].lower_bound\\) \\+ 1, 0> \\* \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[1\\\].lower_bound\\), 0, 0B, &ii, 0B, 0\\);|_gfortran_caf_lock \\(caf_token.1, \\(3 - parm...dim\\\[0\\\].lower_bound\\) \\+ MAX_EXPR <\\(\\(\\(parm...dim\\\[0\\\].lower_bound \\+ parm...dim\\\[0\\\].extent\\) \\+ -1\\) - parm...dim\\\[0\\\].lower_bound\\) \\+ 1, 0> \\* \\(3 - parm...dim\\\[1\\\].lower_bound\\), 0, 0B, &ii, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., \\(2 - \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lower_bound\\) \\+ \\(integer\\(kind=4\\)\\) MAX_EXPR <\\(\\(\\(parm...dim\\\[0\\\].lower_bound \\+ parm...dim\\\[0\\\].extent\\) \\+ -1\\) - parm...dim\\\[0\\\].lower_bound\\) \\+ 1, 0> \\* \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[1\\\].lower_bound\\), 0, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(caf_token.., \\(2 - parm...dim\\\[0\\\].lower_bound\\) \\+ MAX_EXPR <\\(\\(\\(parm...dim\\\[0\\\].lower_bound \\+ parm...dim\\\[0\\\].extent\\) \\+ -1\\) - parm...dim\\\[0\\\].lower_bound\\) \\+ 1, 0> \\* \\(3 - parm...dim\\\[1\\\].lower_bound\\), 0, &ii, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(three.token, 0, 5 - \\(integer\\(kind=4\\)\\) three.dim\\\[0\\\].lbound, &acquired.8, 0B, 0B, 0\\);|_gfortran_caf_lock \\(three.token, 0, 5 - three.dim\\\[0\\\].lbound, &acquired.., 0B, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(three.token, 0, 8 - \\(integer\\(kind=4\\)\\) three.dim\\\[0\\\].lbound, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(three.token, 0, 8 - three.dim\\\[0\\\].lbound, &ii, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(three.token, 0, 5 - \\(integer\\(kind=4\\)\\) three.dim\\\[0\\\].lower_bound, &acquired.8, 0B, 0B, 0\\);|_gfortran_caf_lock \\(three.token, 0, 5 - three.dim\\\[0\\\].lower_bound, &acquired.., 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(three.token, 0, 8 - \\(integer\\(kind=4\\)\\) three.dim\\\[0\\\].lower_bound, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(three.token, 0, 8 - three.dim\\\[0\\\].lower_bound, &ii, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(four.token, 1 - \\(integer\\(kind=4\\)\\) four.dim\\\[0\\\].lbound, 7 - \\(integer\\(kind=4\\)\\) four.dim\\\[1\\\].lbound, &acquired.., &ii, 0B, 0\\);|_gfortran_caf_lock \\(four.token, 1 - four.dim\\\[0\\\].lbound, 7 - four.dim\\\[1\\\].lbound, &acquired.., &ii, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(four.token, 2 - \\(integer\\(kind=4\\)\\) four.dim\\\[0\\\].lbound, 8 - \\(integer\\(kind=4\\)\\) four.dim\\\[1\\\].lbound, 0B, 0B, 0\\);|_gfortran_caf_unlock \\(four.token, 2 - four.dim\\\[0\\\].lbound, 8 - four.dim\\\[1\\\].lbound, 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(four.token, 1 - \\(integer\\(kind=4\\)\\) four.dim\\\[0\\\].lower_bound, 7 - \\(integer\\(kind=4\\)\\) four.dim\\\[1\\\].lower_bound, &acquired.., &ii, 0B, 0\\);|_gfortran_caf_lock \\(four.token, 1 - four.dim\\\[0\\\].lower_bound, 7 - four.dim\\\[1\\\].lower_bound, &acquired.., &ii, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(four.token, 2 - \\(integer\\(kind=4\\)\\) four.dim\\\[0\\\].lower_bound, 8 - \\(integer\\(kind=4\\)\\) four.dim\\\[1\\\].lower_bound, 0B, 0B, 0\\);|_gfortran_caf_unlock \\(four.token, 2 - four.dim\\\[0\\\].lower_bound, 8 - four.dim\\\[1\\\].lower_bound, 0B, 0B, 0\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 index ff574c1ef65..900bf8b3722 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 @@ -19,4 +19,4 @@ allocate(var%x[*]) call sub(var%x) end subroutine test -! { dg-final { scan-tree-dump-times "sub \\(\\(real\\(kind=4\\) \\*\\) var.x.data, var.x.token, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub \\(\\(real\\(kind=4\\) \\*\\) var.x.base_addr, var.x.token, 0\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 index f406da8d352..bc6835b53ce 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 @@ -10,4 +10,4 @@ class(t) :: x allocate(x%x[*]) end subroutine test -! { dg-final { scan-tree-dump-times "x->_data->x.data = _gfortran_caf_register \\(4, 1, &x->_data->x.token, 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "x->_data->x.base_addr = _gfortran_caf_register \\(4, 1, &x->_data->x.token, 0B, 0B, 0\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 index 06c07430b08..09754bb4fe7 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 @@ -18,4 +18,4 @@ end ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_0_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data._data.data\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.base_addr - \\(integer\\(kind=\[48\]\\)\\) y._data._data.base_addr\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 index 65d1c93fede..08f8aca307f 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 @@ -18,4 +18,4 @@ end ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data._data.data\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.base_addr - \\(integer\\(kind=\[48\]\\)\\) y._data._data.base_addr\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 index bfca8a46d10..70900a271c4 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 @@ -18,4 +18,4 @@ end ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data._data.data\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.base_addr - \\(integer\\(kind=\[48\]\\)\\) y._data._data.base_addr\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_stat_function.f90 b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90 index c29687efbe2..8a55ceabb53 100644 --- a/gcc/testsuite/gfortran.dg/coarray_stat_function.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90 @@ -40,6 +40,6 @@ contains end program function_stat -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 4, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 1, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat2\\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 3, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 4, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 1, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat2\\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.base_addr - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 3, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/contiguous_3.f90 b/gcc/testsuite/gfortran.dg/contiguous_3.f90 index 0999f7b5b91..dfd5af53951 100644 --- a/gcc/testsuite/gfortran.dg/contiguous_3.f90 +++ b/gcc/testsuite/gfortran.dg/contiguous_3.f90 @@ -31,10 +31,10 @@ subroutine t2(a1,b1,c2,d2) c2 = d2 end subroutine t2 -! { dg-final { scan-tree-dump-times "= a1->dim.0..stride;" 0 "original" } } -! { dg-final { scan-tree-dump-times "= b1->dim.0..stride;" 0 "original" } } -! { dg-final { scan-tree-dump-times "= c2->dim.0..stride;" 1 "original" } } -! { dg-final { scan-tree-dump-times "= d2->dim.0..stride;" 1 "original" } } +! { dg-final { scan-tree-dump-times "= a1->dim.0..sm" 0 "original" } } +! { dg-final { scan-tree-dump-times "= b1->dim.0..sm" 0 "original" } } +! { dg-final { scan-tree-dump-times "!= 0 . c2->dim.0..sm /.fl. .integer.kind=\[48\].. c2->elem_len : 0;" 1 "original" } } +! { dg-final { scan-tree-dump-times "!= 0 . d2->dim.0..sm /.fl. .integer.kind=\[48\].. d2->elem_len : 0;" 1 "original" } } subroutine test3() @@ -57,7 +57,7 @@ contains end subroutine test3 ! Once for test1 (third call), once for test3 (second call) -! { dg-final { scan-tree-dump-times "data = origptr" 1 "original" } } +! { dg-final { scan-tree-dump-times "base_addr = origptr" 1 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_internal_pack .&parm" 2 "original" } } ! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack .&parm" 2 "original" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_10.f90 b/gcc/testsuite/gfortran.dg/finalize_10.f90 index 937dff5a167..3e21958c4c1 100644 --- a/gcc/testsuite/gfortran.dg/finalize_10.f90 +++ b/gcc/testsuite/gfortran.dg/finalize_10.f90 @@ -31,8 +31,8 @@ end subroutine foo ! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(" 1 "original" } } ! FINALIZE TYPE: -! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void \\*\\) &\\(\\*aa.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.base_addr = \\(void \\*\\) &\\(\\*aa.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } ! { dg-final { scan-tree-dump-times "__final_m_T2 \\(&parm.\[0-9\]+, 0, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "desc.\[0-9\]+.data = \\(void \\* restrict\\) bb;" 1 "original" } } +! { dg-final { scan-tree-dump-times "desc.\[0-9\]+.base_addr = \\(void \\* restrict\\) bb;" 1 "original" } } ! { dg-final { scan-tree-dump-times "__final_m_T2 \\(&desc.\[0-9\]+, 0, 0\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_18.f90 b/gcc/testsuite/gfortran.dg/finalize_18.f90 index c8b4afcff50..f6873f5326b 100644 --- a/gcc/testsuite/gfortran.dg/finalize_18.f90 +++ b/gcc/testsuite/gfortran.dg/finalize_18.f90 @@ -33,11 +33,11 @@ end ! { dg-final { scan-tree-dump-times "if \\(y.aa != 0B\\)" 2 "original" } } ! { dg-final { scan-tree-dump-times "if \\(y.cc._data != 0B\\)" 2 "original" } } -! { dg-final { scan-tree-dump-times "if \\(\\(struct t\\\[0:\\\] . restrict\\) y.bb.data != 0B\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "if \\(\\(struct t\\\[0:\\\] . restrict\\) y.dd._data.data != 0B\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "if \\(\\(struct t\\\[0:\\\] . restrict\\) y.bb.base_addr != 0B\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "if \\(\\(struct t\\\[0:\\\] . restrict\\) y.dd._data.base_addr != 0B\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "desc.\[0-9\]+.data = \\(void . restrict\\) y.aa;" 1 "original" } } -! { dg-final { scan-tree-dump-times "desc.\[0-9\]+.data = \\(void . restrict\\) y.cc._data;" 1 "original" } } +! { dg-final { scan-tree-dump-times "desc.\[0-9\]+.base_addr = \\(void . restrict\\) y.aa;" 1 "original" } } +! { dg-final { scan-tree-dump-times "desc.\[0-9\]+.base_addr = \\(void . restrict\\) y.cc._data;" 1 "original" } } ! { dg-final { scan-tree-dump-times "__final_m_T \\(&desc.\[0-9\]+, 0, 1\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "__final_m_T \\(&y.bb, 0, 1\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/inline_sum_1.f90 b/gcc/testsuite/gfortran.dg/inline_sum_1.f90 index a9d4f7baa78..c6203c2e52c 100644 --- a/gcc/testsuite/gfortran.dg/inline_sum_1.f90 +++ b/gcc/testsuite/gfortran.dg/inline_sum_1.f90 @@ -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 array0._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" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_4.f90 b/gcc/testsuite/gfortran.dg/internal_pack_4.f90 index 368e9804bc4..cd2a0b10d72 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_4.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_4.f90 @@ -26,5 +26,5 @@ USE M1 CALL S2() END -! { dg-final { scan-tree-dump-times "a != 0B \\? \\\(.*\\\) _gfortran_internal_pack" 1 "original" } } -! { dg-final { scan-tree-dump-times "if \\(a != 0B &&" 1 "original" } } +! { dg-final { scan-tree-dump-times " a != 0B && \\(real\\(kind=.\\).0:. . restrict\\) a->base_addr != 0B \\? \\\(.*\\\) _gfortran_internal_pack" 1 "original" } } +! { dg-final { scan-tree-dump-times "if \\(\\(a != 0B && \\(real\\(kind=.\\).0:. . restrict\\) a->base_addr != 0B\\) &&" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 index 923cbc3473d..c74df470fc8 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 @@ -22,4 +22,4 @@ program bug stop end program bug -! { dg-final { scan-tree-dump-times "iszs = \\(integer\\(kind=2\\)\\) MAX_EXPR <\\(D.\[0-9\]+->dim.0..ubound - D.\[0-9\]+->dim.0..lbound\\) \\+ 1, 0>;" 1 "original" } } +! { dg-final { scan-tree-dump-times "iszs = \\(integer\\(kind=2\\)\\) a.dim.0..extent;" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/iso-ts-29113_1.f90 b/gcc/testsuite/gfortran.dg/iso-ts-29113_1.f90 new file mode 100644 index 00000000000..5dec490bee8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso-ts-29113_1.f90 @@ -0,0 +1,49 @@ +! { dg-do run } +! { dg-additional-sources iso-ts-29113_1_c.c } +! +! Test whether accessing the array from C works using +! TS29113's ISO_Fortran_binding.h +! +! The C examples are based on TS29113's. +! +use iso_c_binding +implicit none +real(C_float) :: A(100,100) +real(C_float), allocatable :: B(:,:) +integer :: i, j + +type, bind(c) :: t + real(c_double) :: x + complex(c_double_complex) :: y +end type t + +interface + subroutine test_address(x) bind(C) + import + real(C_float) :: x(..) + end subroutine test_address + subroutine test_allocate(x) bind(C) + import + real(C_float) :: x(..) + end subroutine test_allocate + subroutine test_deallocate(x) bind(C) + import + real(C_float) :: x(..) + end subroutine test_deallocate +end interface + +do i = 1, 100 + do j = 1, 100 + A(j,i) = j + 1000*i + end do +end do +call test_address (A) + +call test_allocate (B) +if (.not. allocated (B)) call abort() +if (any (lbound (B) /= [-1,5])) call abort() +if (any (ubound (B) /= [100,500])) call abort() + +call test_deallocate (B) +if (allocated (B)) call abort() +end diff --git a/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c b/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c new file mode 100644 index 00000000000..9f60b7bd605 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso-ts-29113_1_c.c @@ -0,0 +1,97 @@ +/* To be complied together with iso-ts-29113_1.f90. + + Test whether accessing the array from C works using + TS29113's ISO_Fortran_binding.h + + The examples are based on TS29113's. */ + +#include <ISO_Fortran_binding.h> +#include <stdio.h> +#include <stdlib.h> + +void +test_address (CFI_cdesc_t *dv) +{ + CFI_index_t subscripts[2]; + float *address; + int i, j; + + if (dv->rank != 2) abort (); + if (dv->version != CFI_VERSION) abort (); + if (dv->elem_len != sizeof (float)/ sizeof (char)) abort (); + if (dv->attribute != CFI_attribute_other) abort (); + if (dv->type != CFI_type_float) abort (); + + /* FIXME: TS 29113 requires lower_bound == 0, + currently, lower_bound == 1 is used. */ + if (dv->dim[0].lower_bound != 1) abort (); + if (dv->dim[1].lower_bound != 1) abort (); + if (dv->dim[0].extent != 100) abort (); + if (dv->dim[1].extent != 100) abort (); + if (dv->dim[0].sm != 1*dv->elem_len) abort (); + if (dv->dim[1].sm != 100*dv->elem_len) abort (); + + /* Fixme: LB should be 0. */ + for (i = 1; i <= 100; i++) + for (j = 1; j <= 100; j++) + { + subscripts[0] = j; + subscripts[1] = i; + address = (float *) CFI_address (dv, subscripts); + if (*address != j + 1000*i) abort (); + } +} + +void +test_allocate (CFI_cdesc_t *dv) { + CFI_index_t lower[2], upper[2]; + int ind; + size_t dummy = 0; + + if (dv->rank != 2) abort (); + if (dv->version != CFI_VERSION) abort (); + if (dv->attribute != CFI_attribute_allocatable) abort (); + if (dv->base_addr != NULL) abort (); + if (dv->elem_len != sizeof (float)/ sizeof (char)) abort (); + + lower[0] = -1; + lower[1] = 5; + upper[0] = 100; + upper[1] = 500; + ind = CFI_allocate (dv, lower, upper, dummy); + if (ind != CFI_SUCCESS) abort (); + if (dv->dim[0].lower_bound != -1) abort (); + if (dv->dim[1].lower_bound != 5) abort (); + if (dv->dim[0].extent != 100-(-1)+1) abort (); + if (dv->dim[1].extent != 500-5+1) abort (); + if (dv->dim[0].sm != 1*dv->elem_len) abort (); + if (dv->dim[1].sm != 102*dv->elem_len) abort (); + + ind = CFI_allocate (dv, lower, upper, dummy); + if (ind != CFI_ERROR_BASE_ADDR_NOT_NULL) abort (); +} + +void +test_deallocate (CFI_cdesc_t *dv) { + int ind; + + if (dv->rank != 2) abort (); + if (dv->version != CFI_VERSION) abort (); + if (dv->attribute != CFI_attribute_allocatable) abort (); + if (dv->base_addr == NULL) abort (); + if (dv->elem_len != sizeof (float)/ sizeof (char)) abort (); + + if (dv->dim[0].lower_bound != -1) abort (); + if (dv->dim[1].lower_bound != 5) abort (); + if (dv->dim[0].extent != 100-(-1)+1) abort (); + if (dv->dim[1].extent != 500-5+1) abort (); + if (dv->dim[0].sm != 1*dv->elem_len) abort (); + if (dv->dim[1].sm != 102*dv->elem_len) abort (); + + ind = CFI_deallocate (dv); + if (ind != CFI_SUCCESS) abort (); + if (dv->base_addr != NULL) abort (); + + ind = CFI_deallocate (dv); + if (ind != CFI_ERROR_BASE_ADDR_NULL) abort (); +} diff --git a/gcc/testsuite/gfortran.dg/iso-ts-29113_2.f90 b/gcc/testsuite/gfortran.dg/iso-ts-29113_2.f90 new file mode 100644 index 00000000000..d366f314ea1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso-ts-29113_2.f90 @@ -0,0 +1,157 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Check whether the type files are properly set +! +subroutine test + use iso_c_binding + implicit none + + interface + subroutine foo(x,i) + type(*) :: x(..) + integer(2), value :: i + end subroutine foo + end interface + +! /* Array-descriptor basic types, see ISO_Fortran_binding.h. */ +! #define GFC_TYPE_INTEGER 1 +! #define GFC_TYPE_LOGICAL 2 +! #define GFC_TYPE_REAL 3 +! #define GFC_TYPE_COMPLEX 4 +! #define GFC_TYPE_CHARACTER 5 +! #define GFC_TYPE_STRUCT 6 +! #define GFC_TYPE_CPTR 7 +! #define GFC_TYPE_CFUNPTR 8 +! #define GFC_TYPE_OTHER -1 + + integer(2), parameter :: CFI_Int = 1 + integer(2), parameter :: CFI_Log = 2 + integer(2), parameter :: CFI_Real = 3 + integer(2), parameter :: CFI_Cmplx = 4 + integer(2), parameter :: CFI_Char = 5 + integer(2), parameter :: CFI_Struct = 6 + integer(2), parameter :: CFI_cptr = 7 + integer(2), parameter :: CFI_funcptr = 8 + integer(2), parameter :: CFI_other = -1 + + + integer(1), allocatable :: x_int1(:) + integer(2), allocatable :: x_int2(:) + integer(4), allocatable :: x_int4(:) + integer(8), allocatable :: x_int8(:) + + logical(1), allocatable :: x_log1(:) + logical(2), allocatable :: x_log2(:) + logical(4), allocatable :: x_log4(:) + logical(8), allocatable :: x_log8(:) + + real(4), allocatable :: x_real4(:) + real(8), allocatable :: x_real8(:) + + complex(4), allocatable :: x_cmplx4(:) + complex(8), allocatable :: x_cmplx8(:) + + character(kind=1,len=1), allocatable :: x_str1a(:) + character(kind=1,len=:), allocatable :: x_str1b(:) + character(kind=4,len=1), allocatable :: x_str4a(:) + character(kind=4,len=:), allocatable :: x_str4b(:) + + type(c_ptr), allocatable :: x_cptr(:) + type(c_funptr), allocatable :: x_funcptr(:) + + + type t_seq + sequence + integer :: iii + end type t_seq + + type, bind(C) :: t_bindc + integer(c_int) :: iii + end type t_bindc + + type :: t_ext + integer :: iii + end type t_ext + + type(t_seq), allocatable :: x_seq(:) + type(t_bindc), allocatable :: x_bindc(:) + type(t_ext), allocatable :: x_ext(:) + class(t_ext), allocatable :: x_class(:) + + call foo(x_int1, CFI_Int + ishft (int(kind(x_int1),kind=2),8)) + call foo(x_int2, CFI_Int + ishft (int(kind(x_int2),kind=2),8)) + call foo(x_int4, CFI_Int + ishft (int(kind(x_int4),kind=2),8)) + call foo(x_int8, CFI_Int + ishft (int(kind(x_int8),kind=2),8)) + + call foo(x_log1, CFI_Log + ishft (int(kind(x_log1),kind=2),8)) + call foo(x_log2, CFI_Log + ishft (int(kind(x_log2),kind=2),8)) + call foo(x_log4, CFI_Log + ishft (int(kind(x_log4),kind=2),8)) + call foo(x_log8, CFI_Log + ishft (int(kind(x_log8),kind=2),8)) + + call foo(x_real4, CFI_Real + ishft (int(kind(x_real4),kind=2),8)) + call foo(x_real8, CFI_Real + ishft (int(kind(x_real8),kind=2),8)) + + call foo(x_cmplx4, CFI_cmplx + ishft (int(kind(x_cmplx4),kind=2),8)) + call foo(x_cmplx8, CFI_cmplx + ishft (int(kind(x_cmplx8),kind=2),8)) + + call foo(x_str1a, CFI_char + ishft (int(kind(x_str1a),kind=2),8)) + call foo(x_str1b, CFI_char + ishft (int(kind(x_str1a),kind=2),8)) + call foo(x_str4a, CFI_char + ishft (int(kind(x_str4a),kind=2),8)) + call foo(x_str4b, CFI_char + ishft (int(kind(x_str4a),kind=2),8)) + + call foo(x_cptr, CFI_cptr) + call foo(x_funcptr, CFI_funcptr) + + call foo(x_seq, CFI_struct) + call foo(x_bindc, CFI_struct) + call foo(x_ext, CFI_other) + call foo(x_class, CFI_other) +end subroutine test + +! { dg-final { scan-tree-dump-times "x_cmplx4.type = 1028;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_cmplx8.type = 2052;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_int1.type = 257;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_int2.type = 513;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_int4.type = 1025;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_int8.type = 2049;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_log1.type = 258;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_log2.type = 514;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_log4.type = 1026;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_log8.type = 2050;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_real4.type = 1027;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_real8.type = 2051;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_str1a.type = 261;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_str1b.type = 261;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_str4a.type = 1029;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_str4b.type = 1029;" 1 "original" } } +! { dg-final { scan-tree-dump "x_cptr.type = (1025|2049);" "original" } } +! { dg-final { scan-tree-dump "x_funcptr.type = (1025|2049);" "original" } } +! { dg-final { scan-tree-dump-times "x_seq.type = 6;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_bindc.type = 6;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_ext.type = -1;" 1 "original" } } +! { dg-final { scan-tree-dump-times "x_class._data.type = -1;" 1 "original" } } + +! { dg-final { scan-tree-dump-times "foo \\(&x_int1, 257\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_int2, 513\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_int4, 1025\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_int8, 2049\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_log1, 258\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_log2, 514\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_log4, 1026\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_log8, 2050\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_real4, 1027\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_real8, 2051\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_cmplx4, 1028\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_cmplx8, 2052\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_str1a, 261, 1\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_str1b, 261, .x_str1b\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_str4a, 1029, 1\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_str4b, 1029, .x_str4b\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_cptr, 7\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_funcptr, 8\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_seq, 6\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_bindc, 6\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_ext, -1\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&x_class._data, -1\\);" 1 "original" } } + diff --git a/gcc/testsuite/gfortran.dg/iso-ts-29113_3.f90 b/gcc/testsuite/gfortran.dg/iso-ts-29113_3.f90 new file mode 100644 index 00000000000..b6b7a29ff75 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso-ts-29113_3.f90 @@ -0,0 +1,71 @@ +! { dg-do run } +! { dg-additional-sources iso-ts-29113_3_c.c } +! { dg-options "" } +! +! dg-options is required to silence -pedantic warnings for +! the C code. +! +! Test whether accessing the array from C works using +! TS29113's ISO_Fortran_binding.h +! +! The C examples are based on TS29113's. +! +module m + use iso_c_binding + implicit none + + interface + subroutine test_establish1() bind(C) + end subroutine test_establish1 + subroutine test_establish2() bind(C) + end subroutine test_establish2 + subroutine test_section1(x) bind(C) + import + real(c_float) :: x(:) + end subroutine test_section1 + subroutine test_section2(x) bind(C) + import + real(c_float) :: x(:,:) + end subroutine test_section2 + end interface + + real, target :: A(100) + real, target :: B(100, 100) +contains + subroutine check_section1(x) bind(C) + real(c_float), target :: x(:) + + if (size (x) /= size (A(3::5))) call abort () + if (lbound (x,1) /= lbound (A(3::5),1)) call abort () + if (ubound (x,1) /= ubound (A(3::5),1)) call abort () + if (loc (x(1)) /= loc (A(2))) call abort () ! FIXME: Should be A(3::5), lower_bound 0<->1 issue + if (any (x /= A(2::5))) call abort () + end subroutine + subroutine check_section2(x) bind(C) + real(c_float), target :: x(:) + + if (size (x) /= size (B(:,42))) call abort () + if (lbound (x,1) /= lbound (B(:,42),1)) call abort () + if (ubound (x,1) /= ubound (B(:,42),1)) call abort () + if (loc (x(1)) /= loc (B(1,41))) call abort () ! FIXME: Should be B(1,42), lower_bound 0<->1 issue + if (any (x /= B(:,41))) call abort () ! FIXME: Should be B(:,42), lower_bound 0<->1 issue + end subroutine +end module m + +use m +implicit none +integer :: i,j + +call test_establish1 () +call test_establish2 () + +A = [(i+100, i=0,99)] +call test_section1 (A) + +do j = 1, 100 + do i = 1, 100 + B(i,j) = -i - 1000*j + end do +end do +call test_section2 (B) +end diff --git a/gcc/testsuite/gfortran.dg/iso-ts-29113_3_c.c b/gcc/testsuite/gfortran.dg/iso-ts-29113_3_c.c new file mode 100644 index 00000000000..be2d941a2e3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso-ts-29113_3_c.c @@ -0,0 +1,206 @@ +/* To be complied together with iso-ts-29113_2.f90. + + Test whether accessing the array from C works using + TS29113's ISO_Fortran_binding.h + + The examples are based on TS29113's. */ + +#include <ISO_Fortran_binding.h> +#include <stdio.h> +#include <stdlib.h> + + +void check_section1 (CFI_cdesc_t *); +void check_section2 (CFI_cdesc_t *); + + +void +test_establish1 (void) +{ + int ind; + + /* For establish */ + CFI_rank_t rank; + CFI_CDESC_T(1) field; + + /* For allocate */ + CFI_index_t lower[1], upper[1]; + size_t dummy = 0; + + rank = 1; + ind = CFI_establish ((CFI_cdesc_t *) &field, NULL, CFI_attribute_allocatable, + CFI_type_double, 0, rank, NULL); + + if (ind != CFI_SUCCESS) abort (); + if (field.base_addr != NULL) abort (); + if (field.rank != 1) abort(); + if (field.version != CFI_VERSION) abort (); + if (field.type != CFI_type_double) abort (); + if (field.attribute != CFI_attribute_allocatable) abort (); + + lower[0] = -1; + upper[0] = 100; + ind = CFI_allocate ((CFI_cdesc_t *) &field, lower, upper, dummy); + if (ind != CFI_SUCCESS) abort (); + if (field.elem_len != sizeof (double)) abort (); + if (field.dim[0].lower_bound != -1) abort (); + if (field.dim[0].extent != 100-(-1)+1) abort (); + if (field.dim[0].sm != 1*field.elem_len) abort (); + + ind = CFI_allocate ((CFI_cdesc_t *) &field, lower, upper, dummy); + if (ind != CFI_ERROR_BASE_ADDR_NOT_NULL) abort (); + + ind = CFI_deallocate ((CFI_cdesc_t *) &field); + if (ind != CFI_SUCCESS) abort (); +} + + +void +test_establish2 (void) +{ + int ind; + + /* For establish */ + typedef struct {double x; double _Complex y;} t; + t a_c[100]; + CFI_CDESC_T(1) a_fortran; + CFI_index_t extent[1]; + + /* For allocate */ + CFI_index_t lower[2], upper[2]; + size_t dummy = 0; + + extent[0] = 100; + ind = CFI_establish((CFI_cdesc_t *) &a_fortran, a_c, CFI_attribute_other, + CFI_type_struct, sizeof(t), 1, extent); + + if (ind != CFI_SUCCESS) abort (); + if (a_fortran.base_addr != a_c) abort (); + if (a_fortran.rank != 1) abort(); + if (a_fortran.version != CFI_VERSION) abort (); + if (a_fortran.type != CFI_type_struct) abort (); + if (a_fortran.elem_len != sizeof(t)) abort (); + if (a_fortran.attribute != CFI_attribute_other) abort (); + if (a_fortran.dim[0].lower_bound != 0) abort (); + if (a_fortran.dim[0].extent != 100) abort (); + if (a_fortran.dim[0].sm != a_fortran.elem_len) abort (); + + lower[0] = -1; + upper[0] = 100; + ind = CFI_allocate ((CFI_cdesc_t *) &a_fortran, lower, upper, dummy); + if (ind != CFI_INVALID_ATTRIBUTE) abort (); + + if (a_fortran.base_addr != a_c) abort (); + if (a_fortran.rank != 1) abort(); + if (a_fortran.version != CFI_VERSION) abort (); + if (a_fortran.type != CFI_type_struct) abort (); + if (a_fortran.elem_len != sizeof(t)) abort (); + if (a_fortran.attribute != CFI_attribute_other) abort (); + if (a_fortran.dim[0].lower_bound != 0) abort (); + if (a_fortran.dim[0].extent != 100) abort (); + if (a_fortran.dim[0].sm != a_fortran.elem_len) abort (); +} + + +void +test_section1 (CFI_cdesc_t *source) +{ + int ind; + + CFI_index_t lower_bounds[] = {2}, strides[] = {5}; + CFI_CDESC_T(1) section; + + CFI_rank_t rank = 1; + ind = CFI_establish ((CFI_cdesc_t *) §ion, NULL, + CFI_attribute_other, CFI_type_float, 0, rank, NULL); + if (ind != CFI_SUCCESS) abort (); + if (section.base_addr != NULL) abort (); + if (section.rank != 1) abort(); + if (section.version != CFI_VERSION) abort (); + if (section.type != CFI_type_float) abort (); + if (section.attribute != CFI_attribute_other) abort (); + + if (source->base_addr == NULL) abort (); + if (source->rank != 1) abort(); + if (source->version != CFI_VERSION) abort (); + if (source->type != CFI_type_float) abort (); + if (source->attribute != CFI_attribute_other) abort (); + if (source->elem_len != sizeof(float)) abort (); + /* FIXME: lower_bound should be 0. */ + if (source->dim[0].lower_bound != 1) abort (); + if (source->dim[0].extent != 100) abort (); + if (source->dim[0].sm != source->elem_len) abort (); + + for (ind = 0; ind < 100; ind++) + if (((float *)source->base_addr)[ind] != 100 + ind) abort(); + + ind = CFI_section ((CFI_cdesc_t *) §ion, source, lower_bounds, + NULL, strides); + if (ind != CFI_SUCCESS) abort (); + /* FIXME: Off by one due to 0<->1 lower_bound issue. */ + if (section.base_addr != source->base_addr+1*source->dim[0].sm) abort (); + if (section.dim[0].lower_bound != 2) abort (); /* FIXME: Is this correct? */ + if (section.dim[0].extent != 20) abort (); + if (section.dim[0].sm != source->elem_len*5) abort (); + if (section.rank != 1) abort(); + if (section.version != CFI_VERSION) abort (); + if (section.type != CFI_type_float) abort (); + if (section.attribute != CFI_attribute_other) abort (); + if (section.elem_len != sizeof(float)) abort (); + + check_section1 ((CFI_cdesc_t *) §ion); +} + + +void +test_section2 (CFI_cdesc_t *source) +{ + int ind; + CFI_index_t lower_bounds[] = {source->dim[0].lower_bound, 41}, + upper_bounds[] = {source->dim[0].lower_bound+source->dim[0].extent-1, 41}, + strides[] = {1, 0}; + CFI_CDESC_T(1) section; + + + CFI_rank_t rank = 1 ; + ind = CFI_establish ((CFI_cdesc_t *) §ion, NULL, + CFI_attribute_other, CFI_type_float, 0, rank, NULL); + + if (ind != CFI_SUCCESS) abort (); + if (section.base_addr != NULL) abort (); + if (section.rank != 1) abort(); + if (section.version != CFI_VERSION) abort (); + if (section.type != CFI_type_float) abort (); + if (section.attribute != CFI_attribute_other) abort (); + + if (source->base_addr == NULL) abort (); + if (source->rank != 2) abort(); + if (source->version != CFI_VERSION) abort (); + if (source->type != CFI_type_float) abort (); + if (source->attribute != CFI_attribute_other) abort (); + if (source->elem_len != sizeof(float)) abort (); + /* FIXME: Off by one due to 0<->1 lower_bound issue. */ + if (source->dim[0].lower_bound != 1) abort (); + if (source->dim[1].lower_bound != 1) abort (); + if (source->dim[0].extent != 100) abort (); + if (source->dim[1].extent != 100) abort (); + if (source->dim[0].sm != source->elem_len) abort (); + if (source->dim[1].sm != 100*source->elem_len) abort (); + + ind = CFI_section ((CFI_cdesc_t *) §ion, source, + lower_bounds, upper_bounds, strides ); + if (ind != CFI_SUCCESS) abort (); + /* FIXME: Off by one due to 0<->1 lower_bound issue. */ + if (section.dim[0].lower_bound != 1) abort (); + if (section.dim[0].extent != 100) abort (); + if (section.dim[0].sm != source->elem_len) abort (); + /* FIXME: Off by one due to 0<->1 lower_bound issue. */ + if (section.base_addr != source->base_addr+40*100*source->dim[0].sm) abort (); + if (section.rank != 1) abort(); + if (section.version != CFI_VERSION) abort (); + if (section.type != CFI_type_float) abort (); + if (section.attribute != CFI_attribute_other) abort (); + if (section.elem_len != sizeof(float)) abort (); + + check_section2 ((CFI_cdesc_t *) §ion); +} diff --git a/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 b/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 index b3fb4685efe..5bb35aa4160 100644 --- a/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 +++ b/gcc/testsuite/gfortran.dg/no_arg_check_2.f90 @@ -132,21 +132,21 @@ end ! { dg-final { scan-tree-dump-times "sub_scalar .&array_int.1.," 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(character.kind=1..0:..1:1. .\\) array_char_ptr.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t3.0:. .\\) array_t3_ptr.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.data" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) \\(array_class_t1_ptr._data.dat" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(character.kind=1..0:..1:1. .\\) array_char_ptr.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t3.0:. .\\) array_t3_ptr.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.base_addr" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) \\(array_class_t1_ptr._data.base_addr" 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 3 "original" } } ! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&parm" 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(&array_int\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.data" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.base_addr" 1 "original" } } ! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&array_char_ptr\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "\\.data = \\(void .\\) &array_t1.0.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "\\.base_addr = \\(void .\\) &array_t1.0.;" 1 "original" } } ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) parm" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.data\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.data\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.data\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.base_addr\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.base_addr\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.base_addr\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/pr32921.f b/gcc/testsuite/gfortran.dg/pr32921.f index 0661208edde..154f0e0de67 100644 --- a/gcc/testsuite/gfortran.dg/pr32921.f +++ b/gcc/testsuite/gfortran.dg/pr32921.f @@ -45,4 +45,5 @@ RETURN END -! { dg-final { scan-tree-dump-times "stride" 4 "lim2" } } + +! { dg-final { scan-tree-dump-times "sm" 4 "lim2" } } diff --git a/gcc/testsuite/gfortran.dg/pr43984.f90 b/gcc/testsuite/gfortran.dg/pr43984.f90 index 130d114462c..f2c366444c4 100644 --- a/gcc/testsuite/gfortran.dg/pr43984.f90 +++ b/gcc/testsuite/gfortran.dg/pr43984.f90 @@ -50,6 +50,6 @@ end subroutine end -! There should be two loads from iyz.data, not four. +! There should be two loads from iyz.base_addr, not four. -! { dg-final { scan-tree-dump-times "= iyz.data" 2 "pre" } } +! { dg-final { scan-tree-dump-times "= iyz.base_addr" 2 "pre" } } diff --git a/gcc/testsuite/gfortran.dg/pr48636.f90 b/gcc/testsuite/gfortran.dg/pr48636.f90 index 926d8f3fc5a..94826fa4790 100644 --- a/gcc/testsuite/gfortran.dg/pr48636.f90 +++ b/gcc/testsuite/gfortran.dg/pr48636.f90 @@ -34,5 +34,5 @@ program main end program main ! { dg-final { scan-ipa-dump "bar\[^\\n\]*inline copy in MAIN" "inline" } } -! { dg-final { scan-ipa-dump-times "phi predicate:" 3 "inline" } } +! { dg-final { scan-ipa-dump-times "phi predicate:" 5 "inline" } } ! { dg-final { scan-ipa-dump "inline hints: loop_iterations" "inline" } } diff --git a/gcc/testsuite/gfortran.dg/rank_1.f90 b/gcc/testsuite/gfortran.dg/rank_1.f90 index 6a81e410bd5..3467faded2b 100644 --- a/gcc/testsuite/gfortran.dg/rank_1.f90 +++ b/gcc/testsuite/gfortran.dg/rank_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_18.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_18.f90 index 7dcd22e11b0..cbec679f1ca 100644 --- a/gcc/testsuite/gfortran.dg/realloc_on_assign_18.f90 +++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_18.f90 @@ -16,4 +16,4 @@ if (.not. allocated (y)) call abort () end ! { dg-final { scan-tree-dump "x = \\(struct t .\\) __builtin_malloc \\(1\\);" "original" } } -! { dg-final { scan-tree-dump "y.data = \\(void . restrict\\) __builtin_malloc \\(1\\);" "original" } } +! { dg-final { scan-tree-dump "y.base_addr = \\(void . restrict\\) __builtin_malloc \\(1\\);" "original" } } diff --git a/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 index baa9ad5fff8..1931417a30c 100644 --- a/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 +++ b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 @@ -60,5 +60,5 @@ end ! ! The check below for temporaries gave 14 and 33 for "parm" and "atmp". ! -! { dg-final { scan-tree-dump-times "parm" 66 "original" } } -! { dg-final { scan-tree-dump-times "atmp" 12 "original" } } +! { dg-final { scan-tree-dump-times "parm" 90 "original" } } +! { dg-final { scan-tree-dump-times "atmp" 16 "original" } } diff --git a/libgfortran/ChangeLog.fortran-dev b/libgfortran/ChangeLog.fortran-dev new file mode 100644 index 00000000000..5d8f6e3f37c --- /dev/null +++ b/libgfortran/ChangeLog.fortran-dev @@ -0,0 +1,1314 @@ +2016-09-20 Tobias Burnus <burnus@net-b.de> + + * Makefile.am : Include and use ISO_Fortran_binding.h. + * Makefile.am : Regenerate. + * generated/shape_i1.c : Regenerate. + * generated/shape_i2.c : Regenerate. + +2016-09-07 Paul Thomas <pault@gcc.gnu.org> + + * io/transfer.c (set_nml_var): Update argument list. + (st_set_nml_var, st_set_nml_dtio_var): Likewise. + +2016-08-31 Paul Thomas <pault@gcc.gnu.org> + + * caf/single.c (_gfortran_caf_get, _gfortran_caf_send): Update + for new descriptor ABI. + (CFI_is_contiguous): Handle negative strides. + +2013-05-02 Tobias Burnus <burnus@net-b.de> + + * runtime/iso_ts29113.c (CFI_establish, CFI_select_part): + Correctly set lower_bound. + (CFI_is_contiguous): Handle negative strides. + +2013-04-30 Tobias Burnus <burnus@net-b.de> + + * ISO_Fortran_binding.h.tmpl (CFI_cdesc_t): Change order + and used data types. + * intrinsics/associated.c (associated): Honor macro-name change. + * intrinsics/cshift0.c (cshift0): Ditto. Update type handling. + * intrinsics/date_and_time.c (secnds): Ditto. + * intrinsics/iso_c_binding.c (c_f_pointer, c_f_pointer_u0, + c_f_pointer_d0): Ditto. + * intrinsics/pack_generic.c (pack_internal): Ditto. + * intrinsics/spread_generic.c (spread_internal_scalar, spead, + spread_scalar): Ditto. + * intrinsics/unpack_generic.c (unpack1, unpack0): Ditto. + * runtime/in_pack_generic.c (internal_pack): Ditto. + * runtime/in_unpack_generic.c (internal_unpack): Ditto. + * io/io.h (namelist_type): Rename len into kind. + * io/list_read.c (nml_read_obj): Honor renaming. + * io/write.c (nml_write_obj): Ditto. + * io/transfer.c (transfer_array, st_set_nml_var): Update type + handling. + * libgfortran.h: Add more asserts. + (GFC_DESCRIPTOR_TYPE, GFC_DESCRIPTOR_STRIDE_TYPEKNOWN): Update. + (GFC_DESCRIPTOR_DTYPE, GFC_DTYPE_SIZE_MASK, GFC_DTYPE_TYPE_SIZE_MASK, + GFC_DTYPE_TYPE_SIZE, GFC_DTYPE_INTEGER_1, GFC_DTYPE_INTEGER_*, + GFC_DTYPE_LOGICAL_*, GFC_DTYPE_REAL_*, GFC_DTYPE_COMPLEX_*, + GFC_DTYPE_DERIVED_*): Removed. + * runtime/iso_ts29113.c (CFI_section): Correct offset calc. + (CFI_section): Correct extent calc. + +2013-04-25 Tobias Burnus <burnus@net-b.de> + + * Makefile.am: Fix dependency. + * Makefile.in: Regenerate. + +2013-04-25 Tobias Burnus <burnus@net-b.de> + + * ISO_Fortran_binding.h: Renamed to ... + * ISO_Fortran_binding.h.tmpl: ... this. + * Makefile.am: Install ISO_Fortran_binding.h, + build iso_ts29113. + * gfortran.map (GFORTRAN_1.6): Add TS29113 functions. + * intrinsics/cshift0.c: Update for field+macro renames. + * intrinsics/date_and_time.c: Ditto. + * intrinsics/eoshift0.c: Ditto. + * intrinsics/eoshift2.c: Ditto. + * intrinsics/iso_c_binding.c: Ditto. + * intrinsics/move_alloc.c: Ditto. + * intrinsics/pack_generic.c: Ditto. + * intrinsics/spread_generic.c: Ditto. + * intrinsics/transpose_generic.c: Ditto. + * io/transfer.c: Ditto. + * libgfortran.h: Ditto. + * m4/cshift1.m4: Ditto. + * m4/eoshift1.m4: Ditto. + * m4/eoshift3.m4: Ditto. + * m4/iforeach.m4: Ditto. + * m4/ifunction.m4: Ditto. + * m4/ifunction_logical.m4: Ditto. + * m4/matmull.m4: Ditto. + * m4/pack.m4: Ditto. + * m4/reshape.m4: Ditto. + * m4/spread.m4: Ditto. + * m4/transpose.m4: Ditto. + * m4/unpack.m4: Ditto. + * runtime/bounds.c: Ditto. + * intrinsics/reshape_generic.c (reshape_internal): Ditto. Use sm + instead of stride. + * intrinsics/unpack_generic.c (unpack_internal): Ditto. + * runtime/in_pack_generic.c: Ditto. + * runtime/in_unpack_generic.c: Ditto. + * runtime/iso_ts29113.c: New. + * mk-kinds-ts29113.sh: New. + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated. + * configure: Regenerated. + * generated/all_l1.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/iall_i1.c: Regenerated. + * generated/iall_i16.c: Regenerated. + * generated/iall_i2.c: Regenerated. + * generated/iall_i4.c: Regenerated. + * generated/iall_i8.c: Regenerated. + * generated/iany_i1.c: Regenerated. + * generated/iany_i16.c: Regenerated. + * generated/iany_i2.c: Regenerated. + * generated/iany_i4.c: Regenerated. + * generated/iany_i8.c: Regenerated. + * generated/iparity_i1.c: Regenerated. + * generated/iparity_i16.c: Regenerated. + * generated/iparity_i2.c: Regenerated. + * generated/iparity_i4.c: Regenerated. + * generated/iparity_i8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/norm2_r10.c: Regenerated. + * generated/norm2_r16.c: Regenerated. + * generated/norm2_r4.c: Regenerated. + * generated/norm2_r8.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/pack_c16.c: Regenerated. + * generated/pack_c4.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/pack_i1.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/pack_r16.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/parity_l1.c: Regenerated. + * generated/parity_l16.c: Regenerated. + * generated/parity_l2.c: Regenerated. + * generated/parity_l4.c: Regenerated. + * generated/parity_l8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/transpose_c8.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/unpack_c10.c: Regenerated. + * generated/unpack_c16.c: Regenerated. + * generated/unpack_c4.c: Regenerated. + * generated/unpack_c8.c: Regenerated. + * generated/unpack_i1.c: Regenerated. + * generated/unpack_i16.c: Regenerated. + * generated/unpack_i2.c: Regenerated. + * generated/unpack_i4.c: Regenerated. + * generated/unpack_i8.c: Regenerated. + * generated/unpack_r10.c: Regenerated. + * generated/unpack_r16.c: Regenerated. + * generated/unpack_r4.c: Regenerated. + * generated/unpack_r8.c: Regenerated. + +2013-04-01 Tobias Burnus <burnus@net-b.de> + + * ISO_Fortran_binding.h (CFI_rank_t): Change to int. + (CFI_GFC_CDESC_T): Add rank field. + * intrinsics/reshape_generic.c (reshape_internal): Set rank field. + * intrinsics/spread_generic.c: Ditto. + * io/transfer.c (st_set_nml_var): Add rank argument. + * libgfortran.h (GFC_DESCRIPTOR_RANK): Use rank field. + * m4/iforeach.m4: Set rank field. + * m4/ifunction.m4: Ditto. + * m4/ifunction_logical.m4: Ditto. + * m4/reshape.m4: Ditto. + * m4/spread.m4: Ditto. + * generated/all_l1.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/iall_i1.c: Regenerated. + * generated/iall_i16.c: Regenerated. + * generated/iall_i2.c: Regenerated. + * generated/iall_i4.c: Regenerated. + * generated/iall_i8.c: Regenerated. + * generated/iany_i1.c: Regenerated. + * generated/iany_i16.c: Regenerated. + * generated/iany_i2.c: Regenerated. + * generated/iany_i4.c: Regenerated. + * generated/iany_i8.c: Regenerated. + * generated/iparity_i1.c: Regenerated. + * generated/iparity_i16.c: Regenerated. + * generated/iparity_i2.c: Regenerated. + * generated/iparity_i4.c: Regenerated. + * generated/iparity_i8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/norm2_r10.c: Regenerated. + * generated/norm2_r16.c: Regenerated. + * generated/norm2_r4.c: Regenerated. + * generated/norm2_r8.c: Regenerated. + * generated/parity_l1.c: Regenerated. + * generated/parity_l16.c: Regenerated. + * generated/parity_l2.c: Regenerated. + * generated/parity_l4.c: Regenerated. + * generated/parity_l8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2013-03-31 Tobias Burnus <burnus@net-b.de> + + * ISO_Fortran_binding.h (CFI_cdesc_t): Change size to elem_len + and move up, add version field. + +2012-07-15 Tobias Burnus <burnus@net-b.de> + + * m4/cshift1.m4 (cshift1): Correctly set stride multiplier. + * generated/cshift1_16.c: Regenerate. + * generated/cshift1_4.c: Regenerate. + * generated/cshift1_8.c: Regenerate. + +2012-07-15 Tobias Burnus <burnus@net-b.de> + + * intrinsics/associated.c (associated): Compare sm + instead of stride. + +2012-04-14 Thomas König <tkoenig@gcc.gnu.org> + + * libgfortran.h (GFC_DESCRIPTOR_SIZE_TYPEKNOWN): New macro. + (GFC_DESCRIPTOR_STRIDE_TYPEKNOWN): New macro. + * m4/cshift0.m4: Use GFC_DESCRIPTOR_STRIDE_TYPEKNOWN. + * m4/in_pack.m4: Likewise. + * m4/pack.m4: Likewise. + * m4/spread.m4: Likewise. + * m4/transpose.m4: Likewise. + * m4/iforeach.m4: Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/shape.m4: Likewise. + * m4/cshift1.m4: Likewise. + * m4/in_unpack.m4: Likewise. + * m4/matmull.m4: Likewise. + * m4/bessel.m4: Likewise. + * m4/unpack.m4: Likewise. + * m4/reshape.m4: Likewise. + * m4/ifunction_logical.m4: Likewise. + * m4/ifunction.m4: Likewise. + * m4/matmul.m4: Likewise. + * generated/all_l16.c: Regenerated. + * generated/all_l1.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/bessel_r10.c: Regenerated. + * generated/bessel_r16.c: Regenerated. + * generated/bessel_r4.c: Regenerated. + * generated/bessel_r8.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/cshift0_c10.c: Regenerated. + * generated/cshift0_c16.c: Regenerated. + * generated/cshift0_c4.c: Regenerated. + * generated/cshift0_c8.c: Regenerated. + * generated/cshift0_i16.c: Regenerated. + * generated/cshift0_i1.c: Regenerated. + * generated/cshift0_i2.c: Regenerated. + * generated/cshift0_i4.c: Regenerated. + * generated/cshift0_i8.c: Regenerated. + * generated/cshift0_r10.c: Regenerated. + * generated/cshift0_r16.c: Regenerated. + * generated/cshift0_r4.c: Regenerated. + * generated/cshift0_r8.c: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/iall_i16.c: Regenerated. + * generated/iall_i1.c: Regenerated. + * generated/iall_i2.c: Regenerated. + * generated/iall_i4.c: Regenerated. + * generated/iall_i8.c: Regenerated. + * generated/iany_i16.c: Regenerated. + * generated/iany_i1.c: Regenerated. + * generated/iany_i2.c: Regenerated. + * generated/iany_i4.c: Regenerated. + * generated/iany_i8.c: Regenerated. + * generated/in_pack_c10.c: Regenerated. + * generated/in_pack_c16.c: Regenerated. + * generated/in_pack_c4.c: Regenerated. + * generated/in_pack_c8.c: Regenerated. + * generated/in_pack_i16.c: Regenerated. + * generated/in_pack_i1.c: Regenerated. + * generated/in_pack_i2.c: Regenerated. + * generated/in_pack_i4.c: Regenerated. + * generated/in_pack_i8.c: Regenerated. + * generated/in_pack_r10.c: Regenerated. + * generated/in_pack_r16.c: Regenerated. + * generated/in_pack_r4.c: Regenerated. + * generated/in_pack_r8.c: Regenerated. + * generated/in_unpack_c10.c: Regenerated. + * generated/in_unpack_c16.c: Regenerated. + * generated/in_unpack_c4.c: Regenerated. + * generated/in_unpack_c8.c: Regenerated. + * generated/in_unpack_i16.c: Regenerated. + * generated/in_unpack_i1.c: Regenerated. + * generated/in_unpack_i2.c: Regenerated. + * generated/in_unpack_i4.c: Regenerated. + * generated/in_unpack_i8.c: Regenerated. + * generated/in_unpack_r10.c: Regenerated. + * generated/in_unpack_r16.c: Regenerated. + * generated/in_unpack_r4.c: Regenerated. + * generated/in_unpack_r8.c: Regenerated. + * generated/iparity_i16.c: Regenerated. + * generated/iparity_i1.c: Regenerated. + * generated/iparity_i2.c: Regenerated. + * generated/iparity_i4.c: Regenerated. + * generated/iparity_i8.c: Regenerated. + * generated/matmul_c10.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/matmul_i1.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/norm2_r10.c: Regenerated. + * generated/norm2_r16.c: Regenerated. + * generated/norm2_r4.c: Regenerated. + * generated/norm2_r8.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/pack_c16.c: Regenerated. + * generated/pack_c4.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/pack_i1.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/pack_r16.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/parity_l16.c: Regenerated. + * generated/parity_l1.c: Regenerated. + * generated/parity_l2.c: Regenerated. + * generated/parity_l4.c: Regenerated. + * generated/parity_l8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + * generated/shape_i4.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/transpose_c8.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/unpack_c10.c: Regenerated. + * generated/unpack_c16.c: Regenerated. + * generated/unpack_c4.c: Regenerated. + * generated/unpack_c8.c: Regenerated. + * generated/unpack_i16.c: Regenerated. + * generated/unpack_i1.c: Regenerated. + * generated/unpack_i2.c: Regenerated. + * generated/unpack_i4.c: Regenerated. + * generated/unpack_i8.c: Regenerated. + * generated/unpack_r10.c: Regenerated. + * generated/unpack_r16.c: Regenerated. + * generated/unpack_r4.c: Regenerated. + * generated/unpack_r8.c: Regenerated. + +2012-03-12 Tobias Burnus <burnus@net-b.de> + + * intrinsics/spread_generic.c (spread_internal): Properly use "sm". + +2012-03-12 Tobias Burnus <burnus@net-b.de> + + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Use + GFC_DESCRIPTOR_SM instead of GFC_DESCRIPTOR_STRIDE_BYTES. + +2012-03-11 Tobias Burnus <burnus@net-b.de> + + * ISO_Fortran_binding.h (CFI_dim_t): Remove stride/ubound, + reorder according to TS29113. + * intrinsics/spread_generic.c (spread_internal, + spread_internal_scalar): Update GFC_DIMENSION_SET call, rename + GFC_DESCRIPTOR_STRIDE_BYTES to GFC_DESCRIPTOR_SM. + * intrinsics/eoshift0.c (eoshift0): Ditto. + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Ditto. + * intrinsics/cshift0.c (cshift0): Ditto. + * intrinsics/unpack_generic.c (unpack_internal): Ditto. + * intrinsics/date_and_time.c (secnds): Ditto. + * intrinsics/eoshift2.c (eoshift2): Ditto. + * intrinsics/reshape_generic.c (reshape_internal): Ditto. + * intrinsics/pack_generic.c (pack_internal, pack_s_internal): + Ditto. + * intrinsics/transpose_generic.c (transpose_internal): Ditto. + * intrinsics/move_alloc.c (move_alloc): Ditto. + * io/transfer.c (transfer_array, init_loop_spec): Ditto. + (st_set_nml_var_dim): Use sm/extent rather than ubound/stride + as arguments. + * io/list_read.c (nml_read_obj): Update descriptor_dimension + initialization. + * libgfortran.h (GFC_DIMENSION_SET): Take sm/extent instead of + stride/ubound. + (GFC_DESCRIPTOR_EXTENT, GFC_DESCRIPTOR_UBOUND, + GFC_DESCRIPTOR_STRIDE): Update macros. + (GFC_DESCRIPTOR_SM): Renamed from GFC_DESCRIPTOR_STRIDE_BYTES. + * libtool-version: Bump version number. + * m4/shape.m4 (shape_'rtype_kind`): Update GFC_DIMENSION_SET call, + rename GFC_DESCRIPTOR_STRIDE_BYTES to GFC_DESCRIPTOR_SM. + * m4/cshift1.m4 (cshift1): Ditto. + * m4/matmull.m4 (matmul_'rtype_code`): Ditto. + * m4/eoshift1.m4 (eoshift1): Ditto. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Ditto. + * m4/bessel.m4 (bessel_jn_r'rtype_kind`, bessel_yn_r'rtype_kind`): + Ditto. + * m4/transpose.m4 (transpose_'rtype_code`): Ditto. + * m4/unpack.m4 (unpack0_'rtype_code`, unpack1_'rtype_code`): Ditto. + * m4/matmul.m4 (matmul_'rtype_code`): Ditto. + * m4/spread.m4 (spread_'rtype_code`): Ditto. + * m4/pack.m4 (pack_'rtype_code`): Ditto. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Ditto + * m4/eoshift3.m4 (eoshift3): Ditto. + * m4/reshape.m4 (reshape_'rtype_ccode`): Ditto. + * m4/ifunction_logical.m4 (name`'rtype_qual`_'atype_code): Ditto. + * runtime/bounds.c (count_0): Ditto. + * generated/maxval_i8.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/unpack_c16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/parity_l2.c: Regenerated. + * generated/bessel_r4.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/iany_i8.c: Regenerated. + * generated/norm2_r8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/iparity_i1.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/unpack_c8.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/parity_l4.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/iall_i1.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/matmul_i1.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/unpack_r4.c: Regenerated. + * generated/bessel_r8.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/unpack_i2.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/parity_l8.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/unpack_i4.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/shape_i4.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/unpack_r8.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/iparity_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/iany_i1.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/pack_r16.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/transpose_c8.c: Regenerated. + * generated/unpack_i8.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/pack_c16.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/unpack_i16.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/all_l1.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/parity_l1.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/matmul_c10.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/pack_i1.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/bessel_r10.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/iparity_i2.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/unpack_i1.c: Regenerated. + * generated/iall_i2.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/parity_l16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/iparity_i4.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/iall_i4.c: Regenerated. + * generated/norm2_r10.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/unpack_r10.c: Regenerated. + * generated/bessel_r16.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/iparity_i8.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/iany_i16.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/unpack_c10.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/iall_i8.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/iany_i2.c: Regenerated. + * generated/iall_i16.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/pack_c4.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/sum_r8.c: Regenerated. + * generated/norm2_r16.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/iany_i4.c: Regenerated. + * generated/norm2_r4.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/unpack_c4.c: Regenerated. + * generated/unpack_r16.c: Regenerated. + +2012-03-10 Tobias Burnus <burnus@net-b.de> + + * libgfortran.h (GFC_DIMENSION_UBOUND, GFC_DIMENSION_EXTENT): + Use extent and lower_bound internally. + * io/list_read.c (nml_get_obj_data): Set also sm and extent. + +2012-03-06 Tobias Burnus <burnus@net-b.de> + + * ISO_Fortran_binding.h: New. + * libgfortran.h: Include it. + (descriptor_dimension): Replace by a CFI_dim_t typedef. + (GFC_DIMENSION_SET): Also set extent. + +2010-09-01 Paul Thomas <pault@gcc.gnu.org> + + * libgfortran.h: Add 'sm' and 'extent' fields to structure + descriptor_dimension. Add 'size' field to array descriptor. diff --git a/libgfortran/ISO_Fortran_binding.h.tmpl b/libgfortran/ISO_Fortran_binding.h.tmpl new file mode 100644 index 00000000000..c52052aedf2 --- /dev/null +++ b/libgfortran/ISO_Fortran_binding.h.tmpl @@ -0,0 +1,157 @@ +/* ISO_Fortran_binding.h of GCC's GNU Fortran compiler. + Copyright (C) 2013 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran) +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Library General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with libquadmath; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 51 Franklin Street +- Fifth Floor, Boston, MA 02110-1301, USA. */ + + +/* Definitions as defined by ISO/IEC Technical Specification TS 29113:2012 + on Further Interoperability of Fortran with C. + + Note: This header file contains some GCC-specific CFI_type macros. + Additionally, the order of elements in CFI_cdesc_t (except of the + first three) and of CFI_dim_t is not defined by TS29113 - and both + are permitted to have extra fields. */ + + +#ifndef ISO_FORTRAN_BINDING_H +#define ISO_FORTRAN_BINDING_H + +#ifdef __cplusplus +extern "C" { +#endif + +#include <stddef.h> /* For size_t and ptrdiff_t. */ +#include <stdint.h> /* For int32_t etc. */ + + +/* Constants, defined as macros. */ + +#define CFI_VERSION 1 +#define CFI_MAX_RANK 15 + +/* Attribute values. */ + +#define CFI_attribute_pointer 1 +#define CFI_attribute_allocatable 2 +#define CFI_attribute_other 3 + +/* Error status codes. */ + +#define CFI_SUCCESS 0 +#define CFI_ERROR_BASE_ADDR_NULL 1 +#define CFI_ERROR_BASE_ADDR_NOT_NULL 2 +#define CFI_INVALID_ELEM_LEN 3 +#define CFI_INVALID_RANK 4 +#define CFI_INVALID_TYPE 5 +#define CFI_INVALID_ATTRIBUTE 6 +#define CFI_INVALID_EXTENT 7 +#define CFI_INVALID_DESCRIPTOR 8 +#define CFI_ERROR_MEM_ALLOCATION 9 +#define CFI_ERROR_OUT_OF_BOUNDS 10 + + +/* Types definitions. */ + +typedef ptrdiff_t CFI_index_t; +typedef int8_t CFI_rank_t; +typedef int8_t CFI_attribute_t; +typedef int16_t CFI_type_t; + + +typedef struct CFI_dim_t +{ + CFI_index_t lower_bound; + CFI_index_t extent; + CFI_index_t sm; +} +CFI_dim_t; + +typedef struct CFI_cdesc_t +{ + void *base_addr; + size_t elem_len; + int version; + CFI_rank_t rank; + CFI_attribute_t attribute; + CFI_type_t type; + size_t offset; + CFI_dim_t dim[]; +} +CFI_cdesc_t; + + +/* Extension: CFI_CDESC_T but with an explicit type. */ + +#define CFI_CDESC_TYPE_T(r, base_type) \ +struct {\ + base_type *base_addr;\ + size_t elem_len;\ + int version; \ + CFI_rank_t rank; \ + CFI_attribute_t attribute; \ + CFI_type_t type;\ + size_t offset;\ + CFI_dim_t dim[r];\ +} + +#define CFI_CDESC_T(r) CFI_CDESC_TYPE_T (r, void) + + +/* Functions. */ + +void *CFI_address (const CFI_cdesc_t *, const CFI_index_t []); +int CFI_allocate (CFI_cdesc_t *, const CFI_index_t [], const CFI_index_t [], + size_t); +int CFI_deallocate (CFI_cdesc_t *); +int CFI_establish (CFI_cdesc_t *, void *, CFI_attribute_t, CFI_type_t, size_t, + CFI_rank_t, const CFI_index_t []); +int CFI_is_contiguous (const CFI_cdesc_t *); +int CFI_section (CFI_cdesc_t *, const CFI_cdesc_t *, const CFI_index_t [], + const CFI_index_t [], const CFI_index_t []); +int CFI_select_part (CFI_cdesc_t *, const CFI_cdesc_t *, size_t, size_t); +int CFI_setpointer (CFI_cdesc_t *, CFI_cdesc_t *, const CFI_index_t []); + + +/* Types. Consisting of the type and the kind number. */ + +#define CFI_type_mask 0xFF +#define CFI_type_kind_shift 8 + +/* Intrinsic types - not to be used directly. */ + +#define CFI_type_Integer 1 +#define CFI_type_Logical 2 +#define CFI_type_Real 3 +#define CFI_type_Complex 4 +#define CFI_type_Character 5 + +/* Types without kind paramter. */ + +#define CFI_type_struct 6 +#define CFI_type_cptr 7 +#define CFI_type_cfunptr 8 +#define CFI_type_other -1 + + +/* Types with kind parameter; usually the kind is the same as the byte size. + Exception is REAL(10) which has a size of 64 bytes but only 80 bits + precision. And for complex variables, their byte size is twice the kind + number (except for complex(10)). The ucs4_char matches wchar_t + if sizeof (wchar_t) == 4. */ + +#define CFI_type_char (CFI_type_Character + (1 << CFI_type_kind_shift)) +#define CFI_type_ucs4_char (CFI_type_Character + (4 << CFI_type_kind_shift)) diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 39d3e11d223..8ab57a42dc4 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -30,6 +30,9 @@ version_arg = version_dep = endif +libsubincludedir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include +nodist_libsubinclude_HEADERS = ISO_Fortran_binding.h + LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \ $(lt_host_flags) @@ -40,7 +43,8 @@ libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` $(LTLDFLAGS) $(LIBQUADLIB) ../libbacktrace/libbacktrace.la \ -lm $(extra_ldflags_libgfortran) \ $(version_arg) -Wc,-shared-libgcc -libgfortran_la_DEPENDENCIES = $(version_dep) libgfortran.spec $(LIBQUADLIB_DEP) +libgfortran_la_DEPENDENCIES = ISO_Fortran_binding.h $(version_dep) libgfortran.spec \ + $(LIBQUADLIB_DEP) cafexeclib_LTLIBRARIES = libcaf_single.la cafexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) @@ -213,6 +217,7 @@ runtime/backtrace.c \ runtime/convert_char.c \ runtime/environ.c \ runtime/error.c \ +runtime/iso_ts29113.c \ runtime/fpu.c \ runtime/main.c \ runtime/pause.c \ @@ -697,7 +702,8 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \ $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \ - $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc + $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc \ + ISO_Fortran_binding.h # Machine generated specifics gfor_built_specific_src= \ @@ -919,6 +925,11 @@ I_M4_DEPS2=$(I_M4_DEPS) m4/ifunction_logical.m4 kinds.h: $(srcdir)/mk-kinds-h.sh $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@ +ISO_Fortran_binding.h: $(srcdir)/mk-kinds-ts29113.sh $(srcdir)/ISO_Fortran_binding.h.tmpl + cp $(srcdir)/ISO_Fortran_binding.h.tmpl $@.tmp + $(SHELL) $(srcdir)/mk-kinds-ts29113.sh '$(FCCOMPILE)' >> $@.tmp || rm $@.tmp + mv $@.tmp $@ + kinds.inc: kinds.h grep '^#' < kinds.h > $@ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 7ed080cf7b0..f2081d0fdf6 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -112,6 +112,7 @@ target_triplet = @target@ @LIBGFOR_MINIMAL_FALSE@runtime/convert_char.c \ @LIBGFOR_MINIMAL_FALSE@runtime/environ.c \ @LIBGFOR_MINIMAL_FALSE@runtime/error.c \ +@LIBGFOR_MINIMAL_FALSE@runtime/iso_ts29113.c \ @LIBGFOR_MINIMAL_FALSE@runtime/fpu.c \ @LIBGFOR_MINIMAL_FALSE@runtime/main.c \ @LIBGFOR_MINIMAL_FALSE@runtime/pause.c \ @@ -175,7 +176,7 @@ am__uninstall_files_from_dir = { \ } am__installdirs = "$(DESTDIR)$(cafexeclibdir)" \ "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" \ - "$(DESTDIR)$(fincludedir)" + "$(DESTDIR)$(fincludedir)" "$(DESTDIR)$(libsubincludedir)" LTLIBRARIES = $(cafexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES) libcaf_single_la_LIBADD = am_libcaf_single_la_OBJECTS = single.lo @@ -183,8 +184,8 @@ libcaf_single_la_OBJECTS = $(am_libcaf_single_la_OBJECTS) libgfortran_la_LIBADD = @LIBGFOR_MINIMAL_TRUE@am__objects_1 = minimal.lo @LIBGFOR_MINIMAL_FALSE@am__objects_2 = backtrace.lo convert_char.lo \ -@LIBGFOR_MINIMAL_FALSE@ environ.lo error.lo fpu.lo main.lo \ -@LIBGFOR_MINIMAL_FALSE@ pause.lo stop.lo +@LIBGFOR_MINIMAL_FALSE@ environ.lo error.lo iso_ts29113.lo \ +@LIBGFOR_MINIMAL_FALSE@ fpu.lo main.lo pause.lo stop.lo am__objects_3 = bounds.lo compile_options.lo memory.lo string.lo \ select.lo $(am__objects_1) $(am__objects_2) am__objects_4 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo @@ -431,7 +432,7 @@ am__can_run_installinfo = \ *) (install-info --version) >/dev/null 2>&1;; \ esac DATA = $(toolexeclib_DATA) -HEADERS = $(nodist_finclude_HEADERS) +HEADERS = $(nodist_finclude_HEADERS) $(nodist_libsubinclude_HEADERS) ETAGS = etags CTAGS = ctags ACLOCAL = @ACLOCAL@ @@ -591,6 +592,8 @@ gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) @LIBGFOR_USE_SYMVER_FALSE@version_dep = @LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = $(srcdir)/gfortran.map @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.map-sun +libsubincludedir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include +nodist_libsubinclude_HEADERS = ISO_Fortran_binding.h LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \ $(lt_host_flags) @@ -602,7 +605,9 @@ libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran) \ $(version_arg) -Wc,-shared-libgcc -libgfortran_la_DEPENDENCIES = $(version_dep) libgfortran.spec $(LIBQUADLIB_DEP) +libgfortran_la_DEPENDENCIES = ISO_Fortran_binding.h $(version_dep) libgfortran.spec \ + $(LIBQUADLIB_DEP) + cafexeclib_LTLIBRARIES = libcaf_single.la cafexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) libcaf_single_la_SOURCES = caf/single.c @@ -1130,7 +1135,8 @@ gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \ $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \ - $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc + $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc \ + ISO_Fortran_binding.h # Machine generated specifics @@ -1576,6 +1582,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ishftc.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_binding.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_generated_procs.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_ts29113.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/kill.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libgfortran_c.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/link.Plo@am__quote@ @@ -2439,6 +2446,13 @@ error.lo: runtime/error.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o error.lo `test -f 'runtime/error.c' || echo '$(srcdir)/'`runtime/error.c +iso_ts29113.lo: runtime/iso_ts29113.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iso_ts29113.lo -MD -MP -MF $(DEPDIR)/iso_ts29113.Tpo -c -o iso_ts29113.lo `test -f 'runtime/iso_ts29113.c' || echo '$(srcdir)/'`runtime/iso_ts29113.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iso_ts29113.Tpo $(DEPDIR)/iso_ts29113.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/iso_ts29113.c' object='iso_ts29113.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iso_ts29113.lo `test -f 'runtime/iso_ts29113.c' || echo '$(srcdir)/'`runtime/iso_ts29113.c + fpu.lo: runtime/fpu.c @am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fpu.lo -MD -MP -MF $(DEPDIR)/fpu.Tpo -c -o fpu.lo `test -f 'runtime/fpu.c' || echo '$(srcdir)/'`runtime/fpu.c @am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fpu.Tpo $(DEPDIR)/fpu.Plo @@ -5751,6 +5765,27 @@ uninstall-nodist_fincludeHEADERS: @list='$(nodist_finclude_HEADERS)'; test -n "$(fincludedir)" || list=; \ files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ dir='$(DESTDIR)$(fincludedir)'; $(am__uninstall_files_from_dir) +install-nodist_libsubincludeHEADERS: $(nodist_libsubinclude_HEADERS) + @$(NORMAL_INSTALL) + @list='$(nodist_libsubinclude_HEADERS)'; test -n "$(libsubincludedir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(libsubincludedir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(libsubincludedir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(libsubincludedir)'"; \ + $(INSTALL_HEADER) $$files "$(DESTDIR)$(libsubincludedir)" || exit $$?; \ + done + +uninstall-nodist_libsubincludeHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(nodist_libsubinclude_HEADERS)'; test -n "$(libsubincludedir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(libsubincludedir)'; $(am__uninstall_files_from_dir) ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ @@ -5808,7 +5843,7 @@ check: $(BUILT_SOURCES) $(MAKE) $(AM_MAKEFLAGS) check-am all-am: Makefile $(LTLIBRARIES) all-multi $(DATA) $(HEADERS) config.h installdirs: - for dir in "$(DESTDIR)$(cafexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(fincludedir)"; do \ + for dir in "$(DESTDIR)$(cafexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(fincludedir)" "$(DESTDIR)$(libsubincludedir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: $(BUILT_SOURCES) @@ -5867,7 +5902,8 @@ info: info-am info-am: -install-data-am: install-nodist_fincludeHEADERS +install-data-am: install-nodist_fincludeHEADERS \ + install-nodist_libsubincludeHEADERS install-dvi: install-dvi-am @@ -5917,8 +5953,9 @@ ps: ps-am ps-am: uninstall-am: uninstall-cafexeclibLTLIBRARIES \ - uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \ - uninstall-toolexeclibLTLIBRARIES + uninstall-nodist_fincludeHEADERS \ + uninstall-nodist_libsubincludeHEADERS \ + uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES .MAKE: all all-multi check clean-multi distclean-multi install \ install-am install-multi install-strip maintainer-clean-multi \ @@ -5934,16 +5971,17 @@ uninstall-am: uninstall-cafexeclibLTLIBRARIES \ install-dvi install-dvi-am install-exec install-exec-am \ install-html install-html-am install-info install-info-am \ install-man install-multi install-nodist_fincludeHEADERS \ - install-pdf install-pdf-am install-ps install-ps-am \ - install-strip install-toolexeclibDATA \ + install-nodist_libsubincludeHEADERS install-pdf install-pdf-am \ + install-ps install-ps-am install-strip install-toolexeclibDATA \ install-toolexeclibLTLIBRARIES installcheck installcheck-am \ installdirs maintainer-clean maintainer-clean-generic \ maintainer-clean-multi mostlyclean mostlyclean-compile \ mostlyclean-generic mostlyclean-libtool mostlyclean-multi pdf \ pdf-am ps ps-am tags uninstall uninstall-am \ uninstall-cafexeclibLTLIBRARIES \ - uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \ - uninstall-toolexeclibLTLIBRARIES + uninstall-nodist_fincludeHEADERS \ + uninstall-nodist_libsubincludeHEADERS \ + uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@gfortran.map-sun : $(srcdir)/gfortran.map \ @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(top_srcdir)/../contrib/make_sunver.pl \ @@ -5989,6 +6027,11 @@ ieee_arithmetic.mod: ieee_arithmetic.lo kinds.h: $(srcdir)/mk-kinds-h.sh $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@ +ISO_Fortran_binding.h: $(srcdir)/mk-kinds-ts29113.sh $(srcdir)/ISO_Fortran_binding.h.tmpl + cp $(srcdir)/ISO_Fortran_binding.h.tmpl $@.tmp + $(SHELL) $(srcdir)/mk-kinds-ts29113.sh '$(FCCOMPILE)' >> $@.tmp || rm $@.tmp + mv $@.tmp $@ + kinds.inc: kinds.h grep '^#' < kinds.h > $@ diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index 21916d3ae6f..a45edac4e90 100644 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -600,8 +600,8 @@ _gfortran_caf_get (caf_token_t token, size_t offset, size_t i, k, size; int j; int rank = GFC_DESCRIPTOR_RANK (dest); - size_t src_size = GFC_DESCRIPTOR_SIZE (src); - size_t dst_size = GFC_DESCRIPTOR_SIZE (dest); + size_t src_size = GFC_DESCRIPTOR_ELEM_LEN (src); + size_t dst_size = GFC_DESCRIPTOR_ELEM_LEN (dest); if (stat) *stat = 0; @@ -639,7 +639,7 @@ _gfortran_caf_get (caf_token_t token, size_t offset, size = 1; for (j = 0; j < rank; j++) { - ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1; + ptrdiff_t dimextent = GFC_DESCRIPTOR_EXTENT(dest, j); if (dimextent < 0) dimextent = 0; size *= dimextent; @@ -661,16 +661,17 @@ _gfortran_caf_get (caf_token_t token, size_t offset, ptrdiff_t extent = 1; for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(src, j); array_offset_sr += ((i / (extent*stride)) - % (src->dim[j]._ubound - - src->dim[j].lower_bound + 1)) - * src->dim[j]._stride; - extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1); - stride = src->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(src, j); + extent = GFC_DESCRIPTOR_EXTENT(src, j); + stride = stride_j; } - array_offset_sr += (i / extent) * src->dim[rank-1]._stride; + array_offset_sr += (i / extent) * GFC_DESCRIPTOR_STRIDE(src, + rank -1 ); void *sr = (void *)((char *) TOKEN (token) + offset - + array_offset_sr*GFC_DESCRIPTOR_SIZE (src)); + + array_offset_sr*GFC_DESCRIPTOR_ELEM_LEN (src)); memcpy ((void *) ((char *) tmp + array_offset_dst), sr, src_size); array_offset_dst += src_size; } @@ -683,16 +684,17 @@ _gfortran_caf_get (caf_token_t token, size_t offset, ptrdiff_t extent = 1; for (j = 0; j < rank-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(dest, j); array_offset_dst += ((i / (extent*stride)) - % (dest->dim[j]._ubound - - dest->dim[j].lower_bound + 1)) - * dest->dim[j]._stride; - extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1); - stride = dest->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(dest, j); + extent = GFC_DESCRIPTOR_EXTENT(dest, j); + stride = stride_j; } - array_offset_dst += (i / extent) * dest->dim[rank-1]._stride; + array_offset_dst += (i / extent) * GFC_DESCRIPTOR_STRIDE(dest, + rank -1 ); void *dst = dest->base_addr - + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest); + + array_offset_dst*GFC_DESCRIPTOR_ELEM_LEN (dest); void *sr = tmp + array_offset_sr; if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src) @@ -731,31 +733,33 @@ _gfortran_caf_get (caf_token_t token, size_t offset, ptrdiff_t extent = 1; for (j = 0; j < rank-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(dest, j); array_offset_dst += ((i / (extent*stride)) - % (dest->dim[j]._ubound - - dest->dim[j].lower_bound + 1)) - * dest->dim[j]._stride; - extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1); - stride = dest->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(dest, j); + extent = GFC_DESCRIPTOR_EXTENT(dest, j); + stride = stride_j; } - array_offset_dst += (i / extent) * dest->dim[rank-1]._stride; - void *dst = dest->base_addr + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest); + array_offset_dst += (i / extent) * GFC_DESCRIPTOR_STRIDE(dest, + rank -1 ); + void *dst = dest->base_addr + array_offset_dst*GFC_DESCRIPTOR_ELEM_LEN (dest); ptrdiff_t array_offset_sr = 0; stride = 1; extent = 1; for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(src, j); array_offset_sr += ((i / (extent*stride)) - % (src->dim[j]._ubound - - src->dim[j].lower_bound + 1)) - * src->dim[j]._stride; - extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1); - stride = src->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(src, j); + extent = GFC_DESCRIPTOR_EXTENT(src, j); + stride = stride_j; } - array_offset_sr += (i / extent) * src->dim[rank-1]._stride; + array_offset_sr += (i / extent) * GFC_DESCRIPTOR_STRIDE(src, + rank -1 ); void *sr = (void *)((char *) TOKEN (token) + offset - + array_offset_sr*GFC_DESCRIPTOR_SIZE (src)); + + array_offset_sr*GFC_DESCRIPTOR_ELEM_LEN (src)); if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src) && dst_kind == src_kind) @@ -793,8 +797,8 @@ _gfortran_caf_send (caf_token_t token, size_t offset, size_t i, k, size; int j; int rank = GFC_DESCRIPTOR_RANK (dest); - size_t src_size = GFC_DESCRIPTOR_SIZE (src); - size_t dst_size = GFC_DESCRIPTOR_SIZE (dest); + size_t src_size = GFC_DESCRIPTOR_ELEM_LEN (src); + size_t dst_size = GFC_DESCRIPTOR_ELEM_LEN (dest); if (stat) *stat = 0; @@ -832,7 +836,7 @@ _gfortran_caf_send (caf_token_t token, size_t offset, size = 1; for (j = 0; j < rank; j++) { - ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1; + ptrdiff_t dimextent = GFC_DESCRIPTOR_EXTENT(dest, j); if (dimextent < 0) dimextent = 0; size *= dimextent; @@ -862,16 +866,17 @@ _gfortran_caf_send (caf_token_t token, size_t offset, ptrdiff_t extent = 1; for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(src, j); array_offset_sr += ((i / (extent*stride)) - % (src->dim[j]._ubound - - src->dim[j].lower_bound + 1)) - * src->dim[j]._stride; - extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1); - stride = src->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(src, j); + extent = GFC_DESCRIPTOR_EXTENT(src, j); + stride = stride_j; } - array_offset_sr += (i / extent) * src->dim[rank-1]._stride; + array_offset_sr += (i / extent) * GFC_DESCRIPTOR_STRIDE(src, + rank -1 ); void *sr = (void *) ((char *) src->base_addr - + array_offset_sr*GFC_DESCRIPTOR_SIZE (src)); + + array_offset_sr*GFC_DESCRIPTOR_ELEM_LEN (src)); memcpy ((void *) ((char *) tmp + array_offset_dst), sr, src_size); array_offset_dst += src_size; } @@ -885,16 +890,17 @@ _gfortran_caf_send (caf_token_t token, size_t offset, ptrdiff_t extent = 1; for (j = 0; j < rank-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(dest, j); array_offset_dst += ((i / (extent*stride)) - % (dest->dim[j]._ubound - - dest->dim[j].lower_bound + 1)) - * dest->dim[j]._stride; - extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1); - stride = dest->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(dest, j); + extent = GFC_DESCRIPTOR_EXTENT(dest, j); + stride = stride_j; } - array_offset_dst += (i / extent) * dest->dim[rank-1]._stride; + array_offset_dst += (i / extent) * GFC_DESCRIPTOR_STRIDE(dest, + rank -1 ); void *dst = (void *)((char *) TOKEN (token) + offset - + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest)); + + array_offset_dst*GFC_DESCRIPTOR_ELEM_LEN (dest)); void *sr = tmp + array_offset_sr; if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src) && dst_kind == src_kind) @@ -933,16 +939,17 @@ _gfortran_caf_send (caf_token_t token, size_t offset, ptrdiff_t extent = 1; for (j = 0; j < rank-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(dest, j); array_offset_dst += ((i / (extent*stride)) - % (dest->dim[j]._ubound - - dest->dim[j].lower_bound + 1)) - * dest->dim[j]._stride; - extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1); - stride = dest->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(dest, j); + extent = GFC_DESCRIPTOR_EXTENT(dest, j); + stride = stride_j; } - array_offset_dst += (i / extent) * dest->dim[rank-1]._stride; + array_offset_dst += (i / extent) * GFC_DESCRIPTOR_STRIDE(dest, + rank -1 ); void *dst = (void *)((char *) TOKEN (token) + offset - + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest)); + + array_offset_dst*GFC_DESCRIPTOR_ELEM_LEN (dest)); void *sr; if (GFC_DESCRIPTOR_RANK (src) != 0) { @@ -951,16 +958,17 @@ _gfortran_caf_send (caf_token_t token, size_t offset, extent = 1; for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++) { + ptrdiff_t stride_j = GFC_DESCRIPTOR_STRIDE(src, j); array_offset_sr += ((i / (extent*stride)) - % (src->dim[j]._ubound - - src->dim[j].lower_bound + 1)) - * src->dim[j]._stride; - extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1); - stride = src->dim[j]._stride; + % stride_j) + * GFC_DESCRIPTOR_STRIDE(src, j); + extent = GFC_DESCRIPTOR_EXTENT(src, j); + stride = stride_j; } - array_offset_sr += (i / extent) * src->dim[rank-1]._stride; + array_offset_sr += (i / extent) * GFC_DESCRIPTOR_STRIDE(src, + rank -1 ); sr = (void *)((char *) src->base_addr - + array_offset_sr*GFC_DESCRIPTOR_SIZE (src)); + + array_offset_sr*GFC_DESCRIPTOR_ELEM_LEN (src)); } else sr = src->base_addr; diff --git a/libgfortran/generated/all_l1.c b/libgfortran/generated/all_l1.c index da1a697c3dd..8f45a724447 100644 --- a/libgfortran/generated/all_l1.c +++ b/libgfortran/generated/all_l1.c @@ -58,17 +58,17 @@ all_l1 (gfc_array_l1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ all_l1 (gfc_array_l1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ all_l1 (gfc_array_l1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ all_l1 (gfc_array_l1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/all_l16.c b/libgfortran/generated/all_l16.c index 796f1a0819e..121f7c8eac8 100644 --- a/libgfortran/generated/all_l16.c +++ b/libgfortran/generated/all_l16.c @@ -58,17 +58,17 @@ all_l16 (gfc_array_l16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ all_l16 (gfc_array_l16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ all_l16 (gfc_array_l16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ all_l16 (gfc_array_l16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/all_l2.c b/libgfortran/generated/all_l2.c index 6ca3d92c35f..758d52e3572 100644 --- a/libgfortran/generated/all_l2.c +++ b/libgfortran/generated/all_l2.c @@ -58,17 +58,17 @@ all_l2 (gfc_array_l2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ all_l2 (gfc_array_l2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ all_l2 (gfc_array_l2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ all_l2 (gfc_array_l2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c index aded55c13e7..a0547d4fc78 100644 --- a/libgfortran/generated/all_l4.c +++ b/libgfortran/generated/all_l4.c @@ -58,17 +58,17 @@ all_l4 (gfc_array_l4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ all_l4 (gfc_array_l4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ all_l4 (gfc_array_l4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ all_l4 (gfc_array_l4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/all_l8.c b/libgfortran/generated/all_l8.c index 7b0603b49ce..3465a004d81 100644 --- a/libgfortran/generated/all_l8.c +++ b/libgfortran/generated/all_l8.c @@ -58,17 +58,17 @@ all_l8 (gfc_array_l8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ all_l8 (gfc_array_l8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ all_l8 (gfc_array_l8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ all_l8 (gfc_array_l8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/any_l1.c b/libgfortran/generated/any_l1.c index c96e2d28e55..fc96b5c5c1a 100644 --- a/libgfortran/generated/any_l1.c +++ b/libgfortran/generated/any_l1.c @@ -58,17 +58,17 @@ any_l1 (gfc_array_l1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ any_l1 (gfc_array_l1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ any_l1 (gfc_array_l1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ any_l1 (gfc_array_l1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/any_l16.c b/libgfortran/generated/any_l16.c index 5c70eba1e9c..747a4221ca7 100644 --- a/libgfortran/generated/any_l16.c +++ b/libgfortran/generated/any_l16.c @@ -58,17 +58,17 @@ any_l16 (gfc_array_l16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ any_l16 (gfc_array_l16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ any_l16 (gfc_array_l16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ any_l16 (gfc_array_l16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/any_l2.c b/libgfortran/generated/any_l2.c index 4bb4f44e926..bc4f850b346 100644 --- a/libgfortran/generated/any_l2.c +++ b/libgfortran/generated/any_l2.c @@ -58,17 +58,17 @@ any_l2 (gfc_array_l2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ any_l2 (gfc_array_l2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ any_l2 (gfc_array_l2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ any_l2 (gfc_array_l2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/any_l4.c b/libgfortran/generated/any_l4.c index 601cff035aa..72eca4fb436 100644 --- a/libgfortran/generated/any_l4.c +++ b/libgfortran/generated/any_l4.c @@ -58,17 +58,17 @@ any_l4 (gfc_array_l4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ any_l4 (gfc_array_l4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ any_l4 (gfc_array_l4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ any_l4 (gfc_array_l4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/any_l8.c b/libgfortran/generated/any_l8.c index 798004ee097..ba525732218 100644 --- a/libgfortran/generated/any_l8.c +++ b/libgfortran/generated/any_l8.c @@ -58,17 +58,17 @@ any_l8 (gfc_array_l8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ any_l8 (gfc_array_l8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ any_l8 (gfc_array_l8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ any_l8 (gfc_array_l8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/bessel_r10.c b/libgfortran/generated/bessel_r10.c index 0e89e4a3362..642a944b586 100644 --- a/libgfortran/generated/bessel_r10.c +++ b/libgfortran/generated/bessel_r10.c @@ -49,12 +49,12 @@ bessel_jn_r10 (gfc_array_r10 * const restrict ret, int n1, int n2, GFC_REAL_10 x GFC_REAL_10 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_10)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_10)); ret->offset = 0; } @@ -68,7 +68,7 @@ bessel_jn_r10 (gfc_array_r10 * const restrict ret, int n1, int n2, GFC_REAL_10 x "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { @@ -116,12 +116,12 @@ bessel_yn_r10 (gfc_array_r10 * const restrict ret, int n1, int n2, GFC_REAL_10 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_10)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_10)); ret->offset = 0; } @@ -135,7 +135,7 @@ bessel_yn_r10 (gfc_array_r10 * const restrict ret, int n1, int n2, "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { diff --git a/libgfortran/generated/bessel_r16.c b/libgfortran/generated/bessel_r16.c index f0784dcfd81..5bc6be4642c 100644 --- a/libgfortran/generated/bessel_r16.c +++ b/libgfortran/generated/bessel_r16.c @@ -53,12 +53,12 @@ bessel_jn_r16 (gfc_array_r16 * const restrict ret, int n1, int n2, GFC_REAL_16 x GFC_REAL_16 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_16)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_16)); ret->offset = 0; } @@ -72,7 +72,7 @@ bessel_jn_r16 (gfc_array_r16 * const restrict ret, int n1, int n2, GFC_REAL_16 x "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { @@ -120,12 +120,12 @@ bessel_yn_r16 (gfc_array_r16 * const restrict ret, int n1, int n2, GFC_REAL_16 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_16)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_16)); ret->offset = 0; } @@ -139,7 +139,7 @@ bessel_yn_r16 (gfc_array_r16 * const restrict ret, int n1, int n2, "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { diff --git a/libgfortran/generated/bessel_r4.c b/libgfortran/generated/bessel_r4.c index 445b019f78d..60d9e48c26b 100644 --- a/libgfortran/generated/bessel_r4.c +++ b/libgfortran/generated/bessel_r4.c @@ -49,12 +49,12 @@ bessel_jn_r4 (gfc_array_r4 * const restrict ret, int n1, int n2, GFC_REAL_4 x) GFC_REAL_4 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_4)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_4)); ret->offset = 0; } @@ -68,7 +68,7 @@ bessel_jn_r4 (gfc_array_r4 * const restrict ret, int n1, int n2, GFC_REAL_4 x) "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { @@ -116,12 +116,12 @@ bessel_yn_r4 (gfc_array_r4 * const restrict ret, int n1, int n2, GFC_REAL_4 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_4)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_4)); ret->offset = 0; } @@ -135,7 +135,7 @@ bessel_yn_r4 (gfc_array_r4 * const restrict ret, int n1, int n2, "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { diff --git a/libgfortran/generated/bessel_r8.c b/libgfortran/generated/bessel_r8.c index 1a80f9f9512..e13c561d6f9 100644 --- a/libgfortran/generated/bessel_r8.c +++ b/libgfortran/generated/bessel_r8.c @@ -49,12 +49,12 @@ bessel_jn_r8 (gfc_array_r8 * const restrict ret, int n1, int n2, GFC_REAL_8 x) GFC_REAL_8 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_8)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_8)); ret->offset = 0; } @@ -68,7 +68,7 @@ bessel_jn_r8 (gfc_array_r8 * const restrict ret, int n1, int n2, GFC_REAL_8 x) "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { @@ -116,12 +116,12 @@ bessel_yn_r8 (gfc_array_r8 * const restrict ret, int n1, int n2, GFC_REAL_8 last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof (GFC_REAL_8)); ret->base_addr = xmallocarray (size, sizeof (GFC_REAL_8)); ret->offset = 0; } @@ -135,7 +135,7 @@ bessel_yn_r8 (gfc_array_r8 * const restrict ret, int n1, int n2, "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { diff --git a/libgfortran/generated/count_16_l.c b/libgfortran/generated/count_16_l.c index 9528e6d0cb1..a02fb81205b 100644 --- a/libgfortran/generated/count_16_l.c +++ b/libgfortran/generated/count_16_l.c @@ -58,17 +58,17 @@ count_16_l (gfc_array_i16 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ count_16_l (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ count_16_l (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ count_16_l (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/count_1_l.c b/libgfortran/generated/count_1_l.c index 754c8bb1ea8..2d23fe95bc5 100644 --- a/libgfortran/generated/count_1_l.c +++ b/libgfortran/generated/count_1_l.c @@ -58,17 +58,17 @@ count_1_l (gfc_array_i1 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ count_1_l (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ count_1_l (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ count_1_l (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/count_2_l.c b/libgfortran/generated/count_2_l.c index 35cb7a9726f..27108fada3c 100644 --- a/libgfortran/generated/count_2_l.c +++ b/libgfortran/generated/count_2_l.c @@ -58,17 +58,17 @@ count_2_l (gfc_array_i2 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ count_2_l (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ count_2_l (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ count_2_l (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/count_4_l.c b/libgfortran/generated/count_4_l.c index 8e7e53ab70c..b4509e26dfb 100644 --- a/libgfortran/generated/count_4_l.c +++ b/libgfortran/generated/count_4_l.c @@ -58,17 +58,17 @@ count_4_l (gfc_array_i4 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ count_4_l (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ count_4_l (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ count_4_l (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/count_8_l.c b/libgfortran/generated/count_8_l.c index dce81ce9d8e..5a54437a8ae 100644 --- a/libgfortran/generated/count_8_l.c +++ b/libgfortran/generated/count_8_l.c @@ -58,17 +58,17 @@ count_8_l (gfc_array_i8 * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ count_8_l (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -85,23 +85,23 @@ count_8_l (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -139,7 +139,7 @@ count_8_l (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/cshift0_c10.c b/libgfortran/generated/cshift0_c10.c index 089bde65cda..09a4ceaff58 100644 --- a/libgfortran/generated/cshift0_c10.c +++ b/libgfortran/generated/cshift0_c10.c @@ -69,10 +69,10 @@ cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_c16.c b/libgfortran/generated/cshift0_c16.c index d0c3f2482db..d75ca24891c 100644 --- a/libgfortran/generated/cshift0_c16.c +++ b/libgfortran/generated/cshift0_c16.c @@ -69,10 +69,10 @@ cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_c4.c b/libgfortran/generated/cshift0_c4.c index 99d9bf2f4a5..ba75c6d7f85 100644 --- a/libgfortran/generated/cshift0_c4.c +++ b/libgfortran/generated/cshift0_c4.c @@ -69,10 +69,10 @@ cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_c8.c b/libgfortran/generated/cshift0_c8.c index 491ad2eaed2..5fcdabd60b2 100644 --- a/libgfortran/generated/cshift0_c8.c +++ b/libgfortran/generated/cshift0_c8.c @@ -69,10 +69,10 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i1.c b/libgfortran/generated/cshift0_i1.c index 0300aaaa7f0..525ac54cbb4 100644 --- a/libgfortran/generated/cshift0_i1.c +++ b/libgfortran/generated/cshift0_i1.c @@ -69,10 +69,10 @@ cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i16.c b/libgfortran/generated/cshift0_i16.c index f99ee99b565..3714faa373b 100644 --- a/libgfortran/generated/cshift0_i16.c +++ b/libgfortran/generated/cshift0_i16.c @@ -69,10 +69,10 @@ cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i2.c b/libgfortran/generated/cshift0_i2.c index 0fe0a1bae1a..37de24be0bb 100644 --- a/libgfortran/generated/cshift0_i2.c +++ b/libgfortran/generated/cshift0_i2.c @@ -69,10 +69,10 @@ cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i4.c b/libgfortran/generated/cshift0_i4.c index 88683564403..73a631c5b35 100644 --- a/libgfortran/generated/cshift0_i4.c +++ b/libgfortran/generated/cshift0_i4.c @@ -69,10 +69,10 @@ cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_i8.c b/libgfortran/generated/cshift0_i8.c index 311062c0ceb..183efc30ffe 100644 --- a/libgfortran/generated/cshift0_i8.c +++ b/libgfortran/generated/cshift0_i8.c @@ -69,10 +69,10 @@ cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r10.c b/libgfortran/generated/cshift0_r10.c index fdc5c6a83a5..92d56a58192 100644 --- a/libgfortran/generated/cshift0_r10.c +++ b/libgfortran/generated/cshift0_r10.c @@ -69,10 +69,10 @@ cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r16.c b/libgfortran/generated/cshift0_r16.c index 3951e41c868..fc895ddf9f7 100644 --- a/libgfortran/generated/cshift0_r16.c +++ b/libgfortran/generated/cshift0_r16.c @@ -69,10 +69,10 @@ cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r4.c b/libgfortran/generated/cshift0_r4.c index 1c4cbe30d56..1c7e051cf36 100644 --- a/libgfortran/generated/cshift0_r4.c +++ b/libgfortran/generated/cshift0_r4.c @@ -69,10 +69,10 @@ cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift0_r8.c b/libgfortran/generated/cshift0_r8.c index f9005a9e2d2..40f19dc3921 100644 --- a/libgfortran/generated/cshift0_r8.c +++ b/libgfortran/generated/cshift0_r8.c @@ -69,10 +69,10 @@ cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -81,8 +81,8 @@ cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/generated/cshift1_16.c b/libgfortran/generated/cshift1_16.c index 9d0a3b460f0..8e31c7a1633 100644 --- a/libgfortran/generated/cshift1_16.c +++ b/libgfortran/generated/cshift1_16.c @@ -72,30 +72,27 @@ cshift1 (gfc_array_char * const restrict ret, if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); arraysize = size0 ((array_t *)array); if (ret->base_addr == NULL) { int i; + index_type sm, ext; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; + sm = sizeof (GFC_INTEGER_16); + ext = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + sm *= ext; + ext = GFC_DESCRIPTOR_EXTENT (array, i); - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * - GFC_DESCRIPTOR_STRIDE(ret,i-1); - - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } } else if (unlikely (compile_options.bounds_check)) @@ -126,10 +123,10 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -138,10 +135,10 @@ cshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/generated/cshift1_4.c b/libgfortran/generated/cshift1_4.c index 4e894439dea..2f822eeafd3 100644 --- a/libgfortran/generated/cshift1_4.c +++ b/libgfortran/generated/cshift1_4.c @@ -72,30 +72,27 @@ cshift1 (gfc_array_char * const restrict ret, if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); arraysize = size0 ((array_t *)array); if (ret->base_addr == NULL) { int i; + index_type sm, ext; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; + sm = sizeof (GFC_INTEGER_4); + ext = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + sm *= ext; + ext = GFC_DESCRIPTOR_EXTENT (array, i); - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * - GFC_DESCRIPTOR_STRIDE(ret,i-1); - - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } } else if (unlikely (compile_options.bounds_check)) @@ -126,10 +123,10 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -138,10 +135,10 @@ cshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/generated/cshift1_8.c b/libgfortran/generated/cshift1_8.c index ada5f154961..373a7806d86 100644 --- a/libgfortran/generated/cshift1_8.c +++ b/libgfortran/generated/cshift1_8.c @@ -72,30 +72,27 @@ cshift1 (gfc_array_char * const restrict ret, if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); arraysize = size0 ((array_t *)array); if (ret->base_addr == NULL) { int i; + index_type sm, ext; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; + sm = sizeof (GFC_INTEGER_8); + ext = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + sm *= ext; + ext = GFC_DESCRIPTOR_EXTENT (array, i); - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * - GFC_DESCRIPTOR_STRIDE(ret,i-1); - - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } } else if (unlikely (compile_options.bounds_check)) @@ -126,10 +123,10 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -138,10 +135,10 @@ cshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/generated/eoshift1_16.c b/libgfortran/generated/eoshift1_16.c index dad728d15cd..0e7adf49ab1 100644 --- a/libgfortran/generated/eoshift1_16.c +++ b/libgfortran/generated/eoshift1_16.c @@ -73,7 +73,7 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -88,21 +88,22 @@ eoshift1 (gfc_array_char * const restrict ret, { int i; + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array, i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -129,10 +130,10 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -141,10 +142,10 @@ eoshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/generated/eoshift1_4.c b/libgfortran/generated/eoshift1_4.c index fc2470a2e3e..6afdcef150c 100644 --- a/libgfortran/generated/eoshift1_4.c +++ b/libgfortran/generated/eoshift1_4.c @@ -73,7 +73,7 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -88,21 +88,22 @@ eoshift1 (gfc_array_char * const restrict ret, { int i; + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array, i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -129,10 +130,10 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -141,10 +142,10 @@ eoshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/generated/eoshift1_8.c b/libgfortran/generated/eoshift1_8.c index b56add06e90..ceb191d04ff 100644 --- a/libgfortran/generated/eoshift1_8.c +++ b/libgfortran/generated/eoshift1_8.c @@ -73,7 +73,7 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -88,21 +88,22 @@ eoshift1 (gfc_array_char * const restrict ret, { int i; + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array, i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -129,10 +130,10 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -141,10 +142,10 @@ eoshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/generated/eoshift3_16.c b/libgfortran/generated/eoshift3_16.c index a66988208b1..1d0564b7c7a 100644 --- a/libgfortran/generated/eoshift3_16.c +++ b/libgfortran/generated/eoshift3_16.c @@ -78,7 +78,7 @@ eoshift3 (gfc_array_char * const restrict ret, roffset = 0; arraysize = size0 ((array_t *) array); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -90,21 +90,22 @@ eoshift3 (gfc_array_char * const restrict ret, int i; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array,i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -133,10 +134,10 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -145,12 +146,12 @@ eoshift3 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); if (bound) - bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + bstride[n] = GFC_DESCRIPTOR_SM(bound,n); else bstride[n] = 0; n++; diff --git a/libgfortran/generated/eoshift3_4.c b/libgfortran/generated/eoshift3_4.c index ddfcf2d235a..9be1895bba6 100644 --- a/libgfortran/generated/eoshift3_4.c +++ b/libgfortran/generated/eoshift3_4.c @@ -78,7 +78,7 @@ eoshift3 (gfc_array_char * const restrict ret, roffset = 0; arraysize = size0 ((array_t *) array); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -90,21 +90,22 @@ eoshift3 (gfc_array_char * const restrict ret, int i; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array,i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -133,10 +134,10 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -145,12 +146,12 @@ eoshift3 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); if (bound) - bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + bstride[n] = GFC_DESCRIPTOR_SM(bound,n); else bstride[n] = 0; n++; diff --git a/libgfortran/generated/eoshift3_8.c b/libgfortran/generated/eoshift3_8.c index 9f12d9aabf0..e3988680d82 100644 --- a/libgfortran/generated/eoshift3_8.c +++ b/libgfortran/generated/eoshift3_8.c @@ -78,7 +78,7 @@ eoshift3 (gfc_array_char * const restrict ret, roffset = 0; arraysize = size0 ((array_t *) array); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -90,21 +90,22 @@ eoshift3 (gfc_array_char * const restrict ret, int i; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array,i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -133,10 +134,10 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -145,12 +146,12 @@ eoshift3 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); if (bound) - bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + bstride[n] = GFC_DESCRIPTOR_SM(bound,n); else bstride[n] = 0; n++; diff --git a/libgfortran/generated/iall_i1.c b/libgfortran/generated/iall_i1.c index aec144dcc20..c5f7937a4b5 100644 --- a/libgfortran/generated/iall_i1.c +++ b/libgfortran/generated/iall_i1.c @@ -60,11 +60,11 @@ iall_i1 (gfc_array_i1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iall_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iall_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iall_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miall_i1 (gfc_array_i1 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miall_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miall_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miall_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miall_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siall_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siall_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iall_i16.c b/libgfortran/generated/iall_i16.c index c3eec27c5ae..ebe6da2d30c 100644 --- a/libgfortran/generated/iall_i16.c +++ b/libgfortran/generated/iall_i16.c @@ -60,11 +60,11 @@ iall_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iall_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iall_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iall_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miall_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miall_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miall_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miall_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miall_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siall_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siall_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iall_i2.c b/libgfortran/generated/iall_i2.c index 2b9304e571a..32fd62c07fb 100644 --- a/libgfortran/generated/iall_i2.c +++ b/libgfortran/generated/iall_i2.c @@ -60,11 +60,11 @@ iall_i2 (gfc_array_i2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iall_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iall_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_2)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iall_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miall_i2 (gfc_array_i2 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miall_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miall_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miall_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miall_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siall_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siall_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iall_i4.c b/libgfortran/generated/iall_i4.c index 553372da7cd..432bfd3bfad 100644 --- a/libgfortran/generated/iall_i4.c +++ b/libgfortran/generated/iall_i4.c @@ -60,11 +60,11 @@ iall_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iall_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iall_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iall_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miall_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miall_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miall_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miall_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miall_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siall_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siall_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iall_i8.c b/libgfortran/generated/iall_i8.c index 92ad209688a..ca73209a2b7 100644 --- a/libgfortran/generated/iall_i8.c +++ b/libgfortran/generated/iall_i8.c @@ -60,11 +60,11 @@ iall_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iall_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iall_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iall_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miall_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miall_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miall_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miall_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miall_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siall_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siall_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iany_i1.c b/libgfortran/generated/iany_i1.c index 277d171844e..b82fbeb9642 100644 --- a/libgfortran/generated/iany_i1.c +++ b/libgfortran/generated/iany_i1.c @@ -60,11 +60,11 @@ iany_i1 (gfc_array_i1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iany_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iany_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iany_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miany_i1 (gfc_array_i1 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miany_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miany_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miany_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miany_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siany_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siany_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iany_i16.c b/libgfortran/generated/iany_i16.c index bfa402bbcd3..c0acdc5a405 100644 --- a/libgfortran/generated/iany_i16.c +++ b/libgfortran/generated/iany_i16.c @@ -60,11 +60,11 @@ iany_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iany_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iany_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iany_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miany_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miany_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miany_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miany_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miany_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siany_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siany_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iany_i2.c b/libgfortran/generated/iany_i2.c index 5d2c0f48f1d..21db02c4a58 100644 --- a/libgfortran/generated/iany_i2.c +++ b/libgfortran/generated/iany_i2.c @@ -60,11 +60,11 @@ iany_i2 (gfc_array_i2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iany_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iany_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_2)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iany_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miany_i2 (gfc_array_i2 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miany_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miany_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miany_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miany_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siany_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siany_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iany_i4.c b/libgfortran/generated/iany_i4.c index 8d78510b5d3..6b1d7462042 100644 --- a/libgfortran/generated/iany_i4.c +++ b/libgfortran/generated/iany_i4.c @@ -60,11 +60,11 @@ iany_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iany_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iany_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iany_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miany_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miany_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miany_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miany_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miany_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siany_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siany_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iany_i8.c b/libgfortran/generated/iany_i8.c index b8d9f4c8d3d..fc829a779cd 100644 --- a/libgfortran/generated/iany_i8.c +++ b/libgfortran/generated/iany_i8.c @@ -60,11 +60,11 @@ iany_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iany_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iany_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iany_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miany_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miany_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miany_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miany_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miany_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siany_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siany_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/in_pack_c10.c b/libgfortran/generated/in_pack_c10.c index 069c455865c..215f9cd2da9 100644 --- a/libgfortran/generated/in_pack_c10.c +++ b/libgfortran/generated/in_pack_c10.c @@ -57,7 +57,7 @@ internal_pack_c10 (gfc_array_c10 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_c16.c b/libgfortran/generated/in_pack_c16.c index ca841c705eb..6401b921e3b 100644 --- a/libgfortran/generated/in_pack_c16.c +++ b/libgfortran/generated/in_pack_c16.c @@ -57,7 +57,7 @@ internal_pack_c16 (gfc_array_c16 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_c4.c b/libgfortran/generated/in_pack_c4.c index c48a010cdc8..84951c989ad 100644 --- a/libgfortran/generated/in_pack_c4.c +++ b/libgfortran/generated/in_pack_c4.c @@ -57,7 +57,7 @@ internal_pack_c4 (gfc_array_c4 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_c8.c b/libgfortran/generated/in_pack_c8.c index a5a9ca84235..0ad25f1baed 100644 --- a/libgfortran/generated/in_pack_c8.c +++ b/libgfortran/generated/in_pack_c8.c @@ -57,7 +57,7 @@ internal_pack_c8 (gfc_array_c8 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_i1.c b/libgfortran/generated/in_pack_i1.c index 83cdfa27b4a..90dd7aa15f7 100644 --- a/libgfortran/generated/in_pack_i1.c +++ b/libgfortran/generated/in_pack_i1.c @@ -57,7 +57,7 @@ internal_pack_1 (gfc_array_i1 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_i16.c b/libgfortran/generated/in_pack_i16.c index 3d7ae8c596a..1cb6c7933ca 100644 --- a/libgfortran/generated/in_pack_i16.c +++ b/libgfortran/generated/in_pack_i16.c @@ -57,7 +57,7 @@ internal_pack_16 (gfc_array_i16 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_i2.c b/libgfortran/generated/in_pack_i2.c index 0b38b6a0588..9a7034357ae 100644 --- a/libgfortran/generated/in_pack_i2.c +++ b/libgfortran/generated/in_pack_i2.c @@ -57,7 +57,7 @@ internal_pack_2 (gfc_array_i2 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_i4.c b/libgfortran/generated/in_pack_i4.c index 287331bc90a..40629d020fc 100644 --- a/libgfortran/generated/in_pack_i4.c +++ b/libgfortran/generated/in_pack_i4.c @@ -57,7 +57,7 @@ internal_pack_4 (gfc_array_i4 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_i8.c b/libgfortran/generated/in_pack_i8.c index e1aab2e7f07..1fb8993f1b3 100644 --- a/libgfortran/generated/in_pack_i8.c +++ b/libgfortran/generated/in_pack_i8.c @@ -57,7 +57,7 @@ internal_pack_8 (gfc_array_i8 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_r10.c b/libgfortran/generated/in_pack_r10.c index a2fa52f6466..34d42e1f6d0 100644 --- a/libgfortran/generated/in_pack_r10.c +++ b/libgfortran/generated/in_pack_r10.c @@ -57,7 +57,7 @@ internal_pack_r10 (gfc_array_r10 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_r16.c b/libgfortran/generated/in_pack_r16.c index 1f98a0f538d..94720af25c6 100644 --- a/libgfortran/generated/in_pack_r16.c +++ b/libgfortran/generated/in_pack_r16.c @@ -57,7 +57,7 @@ internal_pack_r16 (gfc_array_r16 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_r4.c b/libgfortran/generated/in_pack_r4.c index d14aff70e94..fd8a7355ddb 100644 --- a/libgfortran/generated/in_pack_r4.c +++ b/libgfortran/generated/in_pack_r4.c @@ -57,7 +57,7 @@ internal_pack_r4 (gfc_array_r4 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_pack_r8.c b/libgfortran/generated/in_pack_r8.c index d1d2fddcb24..ac5a73159b2 100644 --- a/libgfortran/generated/in_pack_r8.c +++ b/libgfortran/generated/in_pack_r8.c @@ -57,7 +57,7 @@ internal_pack_r8 (gfc_array_r8 * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/generated/in_unpack_c10.c b/libgfortran/generated/in_unpack_c10.c index 5701baab797..b62d48f790b 100644 --- a/libgfortran/generated/in_unpack_c10.c +++ b/libgfortran/generated/in_unpack_c10.c @@ -52,7 +52,7 @@ internal_unpack_c10 (gfc_array_c10 * d, const GFC_COMPLEX_10 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_c16.c b/libgfortran/generated/in_unpack_c16.c index c01eafe0d7a..a1c70e3f208 100644 --- a/libgfortran/generated/in_unpack_c16.c +++ b/libgfortran/generated/in_unpack_c16.c @@ -52,7 +52,7 @@ internal_unpack_c16 (gfc_array_c16 * d, const GFC_COMPLEX_16 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_c4.c b/libgfortran/generated/in_unpack_c4.c index 5b64086cdc3..6d536c246ce 100644 --- a/libgfortran/generated/in_unpack_c4.c +++ b/libgfortran/generated/in_unpack_c4.c @@ -52,7 +52,7 @@ internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_c8.c b/libgfortran/generated/in_unpack_c8.c index 944df11a6f4..c8c0b54a8cd 100644 --- a/libgfortran/generated/in_unpack_c8.c +++ b/libgfortran/generated/in_unpack_c8.c @@ -52,7 +52,7 @@ internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i1.c b/libgfortran/generated/in_unpack_i1.c index 32c7be4790a..27939bc0c10 100644 --- a/libgfortran/generated/in_unpack_i1.c +++ b/libgfortran/generated/in_unpack_i1.c @@ -52,7 +52,7 @@ internal_unpack_1 (gfc_array_i1 * d, const GFC_INTEGER_1 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i16.c b/libgfortran/generated/in_unpack_i16.c index de7827f80e5..3ce206ccd92 100644 --- a/libgfortran/generated/in_unpack_i16.c +++ b/libgfortran/generated/in_unpack_i16.c @@ -52,7 +52,7 @@ internal_unpack_16 (gfc_array_i16 * d, const GFC_INTEGER_16 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i2.c b/libgfortran/generated/in_unpack_i2.c index b676e8c1bab..8826f2ee600 100644 --- a/libgfortran/generated/in_unpack_i2.c +++ b/libgfortran/generated/in_unpack_i2.c @@ -52,7 +52,7 @@ internal_unpack_2 (gfc_array_i2 * d, const GFC_INTEGER_2 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i4.c b/libgfortran/generated/in_unpack_i4.c index 49e9423d00f..b9f57835c9e 100644 --- a/libgfortran/generated/in_unpack_i4.c +++ b/libgfortran/generated/in_unpack_i4.c @@ -52,7 +52,7 @@ internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_i8.c b/libgfortran/generated/in_unpack_i8.c index b918a60266c..3d531bb5bdc 100644 --- a/libgfortran/generated/in_unpack_i8.c +++ b/libgfortran/generated/in_unpack_i8.c @@ -52,7 +52,7 @@ internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r10.c b/libgfortran/generated/in_unpack_r10.c index 51896116a73..d811a8da90c 100644 --- a/libgfortran/generated/in_unpack_r10.c +++ b/libgfortran/generated/in_unpack_r10.c @@ -52,7 +52,7 @@ internal_unpack_r10 (gfc_array_r10 * d, const GFC_REAL_10 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r16.c b/libgfortran/generated/in_unpack_r16.c index 8dad7b0b1b9..4642a36f01b 100644 --- a/libgfortran/generated/in_unpack_r16.c +++ b/libgfortran/generated/in_unpack_r16.c @@ -52,7 +52,7 @@ internal_unpack_r16 (gfc_array_r16 * d, const GFC_REAL_16 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r4.c b/libgfortran/generated/in_unpack_r4.c index 6f26a894a04..737fdbf57ae 100644 --- a/libgfortran/generated/in_unpack_r4.c +++ b/libgfortran/generated/in_unpack_r4.c @@ -52,7 +52,7 @@ internal_unpack_r4 (gfc_array_r4 * d, const GFC_REAL_4 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/in_unpack_r8.c b/libgfortran/generated/in_unpack_r8.c index 073aed77b04..57544ac5e0a 100644 --- a/libgfortran/generated/in_unpack_r8.c +++ b/libgfortran/generated/in_unpack_r8.c @@ -52,7 +52,7 @@ internal_unpack_r8 (gfc_array_r8 * d, const GFC_REAL_8 * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/generated/iparity_i1.c b/libgfortran/generated/iparity_i1.c index eb3caa7c1cc..1cf5d451542 100644 --- a/libgfortran/generated/iparity_i1.c +++ b/libgfortran/generated/iparity_i1.c @@ -60,11 +60,11 @@ iparity_i1 (gfc_array_i1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iparity_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iparity_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iparity_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miparity_i1 (gfc_array_i1 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miparity_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miparity_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miparity_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miparity_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siparity_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siparity_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iparity_i16.c b/libgfortran/generated/iparity_i16.c index 23559b8709a..57c9a36de8f 100644 --- a/libgfortran/generated/iparity_i16.c +++ b/libgfortran/generated/iparity_i16.c @@ -60,11 +60,11 @@ iparity_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iparity_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iparity_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iparity_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miparity_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miparity_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miparity_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miparity_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miparity_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siparity_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siparity_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iparity_i2.c b/libgfortran/generated/iparity_i2.c index bd14147b00e..5aa584e0fd0 100644 --- a/libgfortran/generated/iparity_i2.c +++ b/libgfortran/generated/iparity_i2.c @@ -60,11 +60,11 @@ iparity_i2 (gfc_array_i2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iparity_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iparity_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_2)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iparity_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miparity_i2 (gfc_array_i2 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miparity_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miparity_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miparity_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miparity_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siparity_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siparity_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iparity_i4.c b/libgfortran/generated/iparity_i4.c index 26cfd007cc6..f7b70ab69f6 100644 --- a/libgfortran/generated/iparity_i4.c +++ b/libgfortran/generated/iparity_i4.c @@ -60,11 +60,11 @@ iparity_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iparity_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iparity_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iparity_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miparity_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miparity_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miparity_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miparity_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miparity_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siparity_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siparity_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/iparity_i8.c b/libgfortran/generated/iparity_i8.c index ff53fa2a75a..6a209a55824 100644 --- a/libgfortran/generated/iparity_i8.c +++ b/libgfortran/generated/iparity_i8.c @@ -60,11 +60,11 @@ iparity_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ iparity_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ iparity_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ iparity_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ miparity_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ miparity_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ miparity_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ miparity_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ miparity_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ siparity_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ siparity_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/matmul_c10.c b/libgfortran/generated/matmul_c10.c index c9558184988..cf2e26f7e7f 100644 --- a/libgfortran/generated/matmul_c10.c +++ b/libgfortran/generated/matmul_c10.c @@ -106,21 +106,22 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_COMPLEX_10)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_10)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_10)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_COMPLEX_10)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_c16.c b/libgfortran/generated/matmul_c16.c index 25fe56e7674..20f920f0163 100644 --- a/libgfortran/generated/matmul_c16.c +++ b/libgfortran/generated/matmul_c16.c @@ -106,21 +106,22 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_COMPLEX_16)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_16)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_16)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_COMPLEX_16)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_c4.c b/libgfortran/generated/matmul_c4.c index e9d2ed33d5c..f6675b40384 100644 --- a/libgfortran/generated/matmul_c4.c +++ b/libgfortran/generated/matmul_c4.c @@ -106,21 +106,22 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_COMPLEX_4)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_4)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_4)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_COMPLEX_4)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_c8.c b/libgfortran/generated/matmul_c8.c index 8a127da860e..a83b5ab4dee 100644 --- a/libgfortran/generated/matmul_c8.c +++ b/libgfortran/generated/matmul_c8.c @@ -106,21 +106,22 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_COMPLEX_8)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_8)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_COMPLEX_8)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_COMPLEX_8)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_i1.c b/libgfortran/generated/matmul_i1.c index fdb30926911..de68e16119b 100644 --- a/libgfortran/generated/matmul_i1.c +++ b/libgfortran/generated/matmul_i1.c @@ -106,21 +106,22 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_INTEGER_1)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_1)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_1)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_INTEGER_1)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_i16.c b/libgfortran/generated/matmul_i16.c index 80eb63c31ce..ee419823e92 100644 --- a/libgfortran/generated/matmul_i16.c +++ b/libgfortran/generated/matmul_i16.c @@ -106,21 +106,22 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_INTEGER_16)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_16)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_16)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_INTEGER_16)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_i2.c b/libgfortran/generated/matmul_i2.c index 281a0133cbb..fa3fc915b40 100644 --- a/libgfortran/generated/matmul_i2.c +++ b/libgfortran/generated/matmul_i2.c @@ -106,21 +106,22 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_INTEGER_2)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_2)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_2)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_INTEGER_2)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_i4.c b/libgfortran/generated/matmul_i4.c index 2dc526d9b9c..bf1910d2645 100644 --- a/libgfortran/generated/matmul_i4.c +++ b/libgfortran/generated/matmul_i4.c @@ -106,21 +106,22 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_INTEGER_4)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_4)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_4)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_INTEGER_4)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_i8.c b/libgfortran/generated/matmul_i8.c index 0ff728d90e9..1ad58b7dded 100644 --- a/libgfortran/generated/matmul_i8.c +++ b/libgfortran/generated/matmul_i8.c @@ -106,21 +106,22 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_INTEGER_8)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_8)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_INTEGER_8)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_INTEGER_8)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_l16.c b/libgfortran/generated/matmul_l16.c index 34d79f7e275..74541aad6fe 100644 --- a/libgfortran/generated/matmul_l16.c +++ b/libgfortran/generated/matmul_l16.c @@ -69,22 +69,23 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, { if (GFC_DESCRIPTOR_RANK (a) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_LOGICAL_16)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_LOGICAL_16)); } else { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_LOGICAL_16)); - GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DIMENSION_SET (retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_LOGICAL_16)); } retarray->base_addr @@ -134,7 +135,7 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, } abase = a->base_addr; - a_kind = GFC_DESCRIPTOR_SIZE (a); + a_kind = GFC_DESCRIPTOR_ELEM_LEN (a); if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -146,7 +147,7 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, internal_error (NULL, "Funny sized logical array"); bbase = b->base_addr; - b_kind = GFC_DESCRIPTOR_SIZE (b); + b_kind = GFC_DESCRIPTOR_ELEM_LEN (b); if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -162,20 +163,20 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); rystride = rxstride; } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } /* If we have rank 1 parameters, zero the absent stride, and set the size to one. */ if (GFC_DESCRIPTOR_RANK (a) == 1) { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + astride = GFC_DESCRIPTOR_SM(a,0); count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; @@ -183,14 +184,14 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, } else { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + astride = GFC_DESCRIPTOR_SM(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); - xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xstride = GFC_DESCRIPTOR_SM(a,0); xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; @@ -198,9 +199,9 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, } else { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); - ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ystride = GFC_DESCRIPTOR_SM(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_l4.c b/libgfortran/generated/matmul_l4.c index 508820b571f..b52a625d8a9 100644 --- a/libgfortran/generated/matmul_l4.c +++ b/libgfortran/generated/matmul_l4.c @@ -69,22 +69,23 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, { if (GFC_DESCRIPTOR_RANK (a) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_LOGICAL_4)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_LOGICAL_4)); } else { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_LOGICAL_4)); - GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DIMENSION_SET (retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_LOGICAL_4)); } retarray->base_addr @@ -134,7 +135,7 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, } abase = a->base_addr; - a_kind = GFC_DESCRIPTOR_SIZE (a); + a_kind = GFC_DESCRIPTOR_ELEM_LEN (a); if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -146,7 +147,7 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, internal_error (NULL, "Funny sized logical array"); bbase = b->base_addr; - b_kind = GFC_DESCRIPTOR_SIZE (b); + b_kind = GFC_DESCRIPTOR_ELEM_LEN (b); if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -162,20 +163,20 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); rystride = rxstride; } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } /* If we have rank 1 parameters, zero the absent stride, and set the size to one. */ if (GFC_DESCRIPTOR_RANK (a) == 1) { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + astride = GFC_DESCRIPTOR_SM(a,0); count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; @@ -183,14 +184,14 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, } else { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + astride = GFC_DESCRIPTOR_SM(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); - xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xstride = GFC_DESCRIPTOR_SM(a,0); xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; @@ -198,9 +199,9 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, } else { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); - ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ystride = GFC_DESCRIPTOR_SM(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_l8.c b/libgfortran/generated/matmul_l8.c index decd77623b0..8f026e51eeb 100644 --- a/libgfortran/generated/matmul_l8.c +++ b/libgfortran/generated/matmul_l8.c @@ -69,22 +69,23 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, { if (GFC_DESCRIPTOR_RANK (a) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_LOGICAL_8)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_LOGICAL_8)); } else { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_LOGICAL_8)); - GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DIMENSION_SET (retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_LOGICAL_8)); } retarray->base_addr @@ -134,7 +135,7 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, } abase = a->base_addr; - a_kind = GFC_DESCRIPTOR_SIZE (a); + a_kind = GFC_DESCRIPTOR_ELEM_LEN (a); if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -146,7 +147,7 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, internal_error (NULL, "Funny sized logical array"); bbase = b->base_addr; - b_kind = GFC_DESCRIPTOR_SIZE (b); + b_kind = GFC_DESCRIPTOR_ELEM_LEN (b); if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -162,20 +163,20 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); rystride = rxstride; } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } /* If we have rank 1 parameters, zero the absent stride, and set the size to one. */ if (GFC_DESCRIPTOR_RANK (a) == 1) { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + astride = GFC_DESCRIPTOR_SM(a,0); count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; @@ -183,14 +184,14 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, } else { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + astride = GFC_DESCRIPTOR_SM(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); - xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xstride = GFC_DESCRIPTOR_SM(a,0); xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; @@ -198,9 +199,9 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, } else { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); - ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ystride = GFC_DESCRIPTOR_SM(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_r10.c b/libgfortran/generated/matmul_r10.c index a34856f010f..c5e9294965f 100644 --- a/libgfortran/generated/matmul_r10.c +++ b/libgfortran/generated/matmul_r10.c @@ -106,21 +106,22 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_REAL_10)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_10)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_10)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_REAL_10)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_r16.c b/libgfortran/generated/matmul_r16.c index d2f11bdd984..3061e9dbc50 100644 --- a/libgfortran/generated/matmul_r16.c +++ b/libgfortran/generated/matmul_r16.c @@ -106,21 +106,22 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_REAL_16)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_16)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_16)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_REAL_16)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_r4.c b/libgfortran/generated/matmul_r4.c index ff3b93ff4d4..e6aef93d123 100644 --- a/libgfortran/generated/matmul_r4.c +++ b/libgfortran/generated/matmul_r4.c @@ -106,21 +106,22 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_REAL_4)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_4)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_4)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_REAL_4)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/matmul_r8.c b/libgfortran/generated/matmul_r8.c index af805ee45ee..3d42179af1f 100644 --- a/libgfortran/generated/matmul_r8.c +++ b/libgfortran/generated/matmul_r8.c @@ -106,21 +106,22 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof (GFC_REAL_8)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_8)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof (GFC_REAL_8)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof (GFC_REAL_8)); } retarray->base_addr @@ -175,19 +176,19 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -195,8 +196,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -211,7 +212,7 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -221,8 +222,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray, } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/generated/maxloc0_16_i1.c b/libgfortran/generated/maxloc0_16_i1.c index d2a6cd88a34..b11efc4a1a6 100644 --- a/libgfortran/generated/maxloc0_16_i1.c +++ b/libgfortran/generated/maxloc0_16_i1.c @@ -55,8 +55,9 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i16.c b/libgfortran/generated/maxloc0_16_i16.c index 50a3e93111e..a6117475639 100644 --- a/libgfortran/generated/maxloc0_16_i16.c +++ b/libgfortran/generated/maxloc0_16_i16.c @@ -55,8 +55,9 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i2.c b/libgfortran/generated/maxloc0_16_i2.c index b66c7cd9070..6b23b6cdcaf 100644 --- a/libgfortran/generated/maxloc0_16_i2.c +++ b/libgfortran/generated/maxloc0_16_i2.c @@ -55,8 +55,9 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i4.c b/libgfortran/generated/maxloc0_16_i4.c index 28914b6efc5..df985331620 100644 --- a/libgfortran/generated/maxloc0_16_i4.c +++ b/libgfortran/generated/maxloc0_16_i4.c @@ -55,8 +55,9 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_i8.c b/libgfortran/generated/maxloc0_16_i8.c index a95b2814736..bbc2eb66dc0 100644 --- a/libgfortran/generated/maxloc0_16_i8.c +++ b/libgfortran/generated/maxloc0_16_i8.c @@ -55,8 +55,9 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r10.c b/libgfortran/generated/maxloc0_16_r10.c index 4434ada2130..10e00beedc6 100644 --- a/libgfortran/generated/maxloc0_16_r10.c +++ b/libgfortran/generated/maxloc0_16_r10.c @@ -55,8 +55,9 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r16.c b/libgfortran/generated/maxloc0_16_r16.c index 57417a48424..da5de36c946 100644 --- a/libgfortran/generated/maxloc0_16_r16.c +++ b/libgfortran/generated/maxloc0_16_r16.c @@ -55,8 +55,9 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r4.c b/libgfortran/generated/maxloc0_16_r4.c index ed840935c55..d10a853671e 100644 --- a/libgfortran/generated/maxloc0_16_r4.c +++ b/libgfortran/generated/maxloc0_16_r4.c @@ -55,8 +55,9 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_16_r8.c b/libgfortran/generated/maxloc0_16_r8.c index 2093a87b236..d7df44e3b91 100644 --- a/libgfortran/generated/maxloc0_16_r8.c +++ b/libgfortran/generated/maxloc0_16_r8.c @@ -55,8 +55,9 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i1.c b/libgfortran/generated/maxloc0_4_i1.c index 73faf9b9c22..93edc7cae7b 100644 --- a/libgfortran/generated/maxloc0_4_i1.c +++ b/libgfortran/generated/maxloc0_4_i1.c @@ -55,8 +55,9 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i16.c b/libgfortran/generated/maxloc0_4_i16.c index e3642e547a7..731c07a0f56 100644 --- a/libgfortran/generated/maxloc0_4_i16.c +++ b/libgfortran/generated/maxloc0_4_i16.c @@ -55,8 +55,9 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i2.c b/libgfortran/generated/maxloc0_4_i2.c index 52156485060..fd27958929a 100644 --- a/libgfortran/generated/maxloc0_4_i2.c +++ b/libgfortran/generated/maxloc0_4_i2.c @@ -55,8 +55,9 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i4.c b/libgfortran/generated/maxloc0_4_i4.c index 40b4c95d546..ac08efa8043 100644 --- a/libgfortran/generated/maxloc0_4_i4.c +++ b/libgfortran/generated/maxloc0_4_i4.c @@ -55,8 +55,9 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_i8.c b/libgfortran/generated/maxloc0_4_i8.c index c78dc86d483..5db82c94f9f 100644 --- a/libgfortran/generated/maxloc0_4_i8.c +++ b/libgfortran/generated/maxloc0_4_i8.c @@ -55,8 +55,9 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r10.c b/libgfortran/generated/maxloc0_4_r10.c index 0db125f082b..be79a7417ea 100644 --- a/libgfortran/generated/maxloc0_4_r10.c +++ b/libgfortran/generated/maxloc0_4_r10.c @@ -55,8 +55,9 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r16.c b/libgfortran/generated/maxloc0_4_r16.c index a71017ed022..22c6c3f7669 100644 --- a/libgfortran/generated/maxloc0_4_r16.c +++ b/libgfortran/generated/maxloc0_4_r16.c @@ -55,8 +55,9 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r4.c b/libgfortran/generated/maxloc0_4_r4.c index 8cb24866d78..38fb4bcfd83 100644 --- a/libgfortran/generated/maxloc0_4_r4.c +++ b/libgfortran/generated/maxloc0_4_r4.c @@ -55,8 +55,9 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_4_r8.c b/libgfortran/generated/maxloc0_4_r8.c index f7cba4a23de..0ec4c6196b6 100644 --- a/libgfortran/generated/maxloc0_4_r8.c +++ b/libgfortran/generated/maxloc0_4_r8.c @@ -55,8 +55,9 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i1.c b/libgfortran/generated/maxloc0_8_i1.c index 1f6c71893a6..9b2800d10be 100644 --- a/libgfortran/generated/maxloc0_8_i1.c +++ b/libgfortran/generated/maxloc0_8_i1.c @@ -55,8 +55,9 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i16.c b/libgfortran/generated/maxloc0_8_i16.c index 06730919967..426f2f2115d 100644 --- a/libgfortran/generated/maxloc0_8_i16.c +++ b/libgfortran/generated/maxloc0_8_i16.c @@ -55,8 +55,9 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i2.c b/libgfortran/generated/maxloc0_8_i2.c index f3f9667e134..39c1465b352 100644 --- a/libgfortran/generated/maxloc0_8_i2.c +++ b/libgfortran/generated/maxloc0_8_i2.c @@ -55,8 +55,9 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i4.c b/libgfortran/generated/maxloc0_8_i4.c index c5aa24541fb..fc11fed4f07 100644 --- a/libgfortran/generated/maxloc0_8_i4.c +++ b/libgfortran/generated/maxloc0_8_i4.c @@ -55,8 +55,9 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_i8.c b/libgfortran/generated/maxloc0_8_i8.c index ede4a3341f4..6b9c61a213e 100644 --- a/libgfortran/generated/maxloc0_8_i8.c +++ b/libgfortran/generated/maxloc0_8_i8.c @@ -55,8 +55,9 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r10.c b/libgfortran/generated/maxloc0_8_r10.c index 31f749cab66..12fb7af3ebf 100644 --- a/libgfortran/generated/maxloc0_8_r10.c +++ b/libgfortran/generated/maxloc0_8_r10.c @@ -55,8 +55,9 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r16.c b/libgfortran/generated/maxloc0_8_r16.c index 342ca4cbe10..351b9ca8d92 100644 --- a/libgfortran/generated/maxloc0_8_r16.c +++ b/libgfortran/generated/maxloc0_8_r16.c @@ -55,8 +55,9 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r4.c b/libgfortran/generated/maxloc0_8_r4.c index c68c52201ec..bed108fe397 100644 --- a/libgfortran/generated/maxloc0_8_r4.c +++ b/libgfortran/generated/maxloc0_8_r4.c @@ -55,8 +55,9 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc0_8_r8.c b/libgfortran/generated/maxloc0_8_r8.c index 06f48cce587..8846312ec92 100644 --- a/libgfortran/generated/maxloc0_8_r8.c +++ b/libgfortran/generated/maxloc0_8_r8.c @@ -55,8 +55,9 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, "MAXLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/maxloc1_16_i1.c b/libgfortran/generated/maxloc1_16_i1.c index 8da0b3b1eec..c1cd9192807 100644 --- a/libgfortran/generated/maxloc1_16_i1.c +++ b/libgfortran/generated/maxloc1_16_i1.c @@ -61,11 +61,11 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_i16.c b/libgfortran/generated/maxloc1_16_i16.c index 5fea3b4c12a..88cb2e18da8 100644 --- a/libgfortran/generated/maxloc1_16_i16.c +++ b/libgfortran/generated/maxloc1_16_i16.c @@ -61,11 +61,11 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_i2.c b/libgfortran/generated/maxloc1_16_i2.c index f11260f932e..9dd1f7ee3c1 100644 --- a/libgfortran/generated/maxloc1_16_i2.c +++ b/libgfortran/generated/maxloc1_16_i2.c @@ -61,11 +61,11 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c index fc692dffe9c..dfcd09d548e 100644 --- a/libgfortran/generated/maxloc1_16_i4.c +++ b/libgfortran/generated/maxloc1_16_i4.c @@ -61,11 +61,11 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c index c5da3d99336..a8e06eff34e 100644 --- a/libgfortran/generated/maxloc1_16_i8.c +++ b/libgfortran/generated/maxloc1_16_i8.c @@ -61,11 +61,11 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c index 829ce8da765..119d9ad7188 100644 --- a/libgfortran/generated/maxloc1_16_r10.c +++ b/libgfortran/generated/maxloc1_16_r10.c @@ -61,11 +61,11 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c index f1b7d8d779f..498de405ffd 100644 --- a/libgfortran/generated/maxloc1_16_r16.c +++ b/libgfortran/generated/maxloc1_16_r16.c @@ -61,11 +61,11 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c index 9f8ca921238..b4597638f59 100644 --- a/libgfortran/generated/maxloc1_16_r4.c +++ b/libgfortran/generated/maxloc1_16_r4.c @@ -61,11 +61,11 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c index 3442ebdbc0f..34bdd146bdc 100644 --- a/libgfortran/generated/maxloc1_16_r8.c +++ b/libgfortran/generated/maxloc1_16_r8.c @@ -61,11 +61,11 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_i1.c b/libgfortran/generated/maxloc1_4_i1.c index 00cf9d4d095..16b38838f63 100644 --- a/libgfortran/generated/maxloc1_4_i1.c +++ b/libgfortran/generated/maxloc1_4_i1.c @@ -61,11 +61,11 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c index ee4699171e3..c6dce3a9f85 100644 --- a/libgfortran/generated/maxloc1_4_i16.c +++ b/libgfortran/generated/maxloc1_4_i16.c @@ -61,11 +61,11 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_i2.c b/libgfortran/generated/maxloc1_4_i2.c index 1ff679db178..198474bba6a 100644 --- a/libgfortran/generated/maxloc1_4_i2.c +++ b/libgfortran/generated/maxloc1_4_i2.c @@ -61,11 +61,11 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c index 164eca80fb4..f3bf7a2b2ab 100644 --- a/libgfortran/generated/maxloc1_4_i4.c +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -61,11 +61,11 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c index 3da845b8c13..c60da5772a5 100644 --- a/libgfortran/generated/maxloc1_4_i8.c +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -61,11 +61,11 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c index 3913a72b414..708ba3e73f1 100644 --- a/libgfortran/generated/maxloc1_4_r10.c +++ b/libgfortran/generated/maxloc1_4_r10.c @@ -61,11 +61,11 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c index e4798cfec2f..d658f7d2a43 100644 --- a/libgfortran/generated/maxloc1_4_r16.c +++ b/libgfortran/generated/maxloc1_4_r16.c @@ -61,11 +61,11 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c index d7deee55757..ea4810c9b5d 100644 --- a/libgfortran/generated/maxloc1_4_r4.c +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -61,11 +61,11 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c index 516b4fdddac..ef70ce9a0a3 100644 --- a/libgfortran/generated/maxloc1_4_r8.c +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -61,11 +61,11 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_i1.c b/libgfortran/generated/maxloc1_8_i1.c index afb7dc1c733..3142f60cd89 100644 --- a/libgfortran/generated/maxloc1_8_i1.c +++ b/libgfortran/generated/maxloc1_8_i1.c @@ -61,11 +61,11 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c index bdcb96f50fc..a5cceee2d5a 100644 --- a/libgfortran/generated/maxloc1_8_i16.c +++ b/libgfortran/generated/maxloc1_8_i16.c @@ -61,11 +61,11 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_i2.c b/libgfortran/generated/maxloc1_8_i2.c index 57c5a6a3e44..f9152ff0004 100644 --- a/libgfortran/generated/maxloc1_8_i2.c +++ b/libgfortran/generated/maxloc1_8_i2.c @@ -61,11 +61,11 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c index e2e5e923687..7187af69b4d 100644 --- a/libgfortran/generated/maxloc1_8_i4.c +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -61,11 +61,11 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c index 5c7f25bc21b..a6c799800a6 100644 --- a/libgfortran/generated/maxloc1_8_i8.c +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -61,11 +61,11 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c index 1dedc6fb8ee..8c1d7831fc9 100644 --- a/libgfortran/generated/maxloc1_8_r10.c +++ b/libgfortran/generated/maxloc1_8_r10.c @@ -61,11 +61,11 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c index d5b8c7ae18f..b77e2d8acbe 100644 --- a/libgfortran/generated/maxloc1_8_r16.c +++ b/libgfortran/generated/maxloc1_8_r16.c @@ -61,11 +61,11 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c index 9da0635aced..7e6a853d7c5 100644 --- a/libgfortran/generated/maxloc1_8_r4.c +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -61,11 +61,11 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c index 8e3a08abd6a..ed1d3e6087a 100644 --- a/libgfortran/generated/maxloc1_8_r8.c +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -61,11 +61,11 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_i1.c b/libgfortran/generated/maxval_i1.c index 94390baec40..511db7cf645 100644 --- a/libgfortran/generated/maxval_i1.c +++ b/libgfortran/generated/maxval_i1.c @@ -60,11 +60,11 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c index 841c852b786..5f0c4cca593 100644 --- a/libgfortran/generated/maxval_i16.c +++ b/libgfortran/generated/maxval_i16.c @@ -60,11 +60,11 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_i2.c b/libgfortran/generated/maxval_i2.c index 4b0b50a84e4..36da39721d5 100644 --- a/libgfortran/generated/maxval_i2.c +++ b/libgfortran/generated/maxval_i2.c @@ -60,11 +60,11 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_2)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c index 91ba6b69e0f..7846cbfa6f2 100644 --- a/libgfortran/generated/maxval_i4.c +++ b/libgfortran/generated/maxval_i4.c @@ -60,11 +60,11 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c index 2f96b3767db..a500ddbf04c 100644 --- a/libgfortran/generated/maxval_i8.c +++ b/libgfortran/generated/maxval_i8.c @@ -60,11 +60,11 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c index 204621bdd9d..3eb14ed7b2f 100644 --- a/libgfortran/generated/maxval_r10.c +++ b/libgfortran/generated/maxval_r10.c @@ -60,11 +60,11 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_10)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c index 31ed1d8e828..be8c2bcd03b 100644 --- a/libgfortran/generated/maxval_r16.c +++ b/libgfortran/generated/maxval_r16.c @@ -60,11 +60,11 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c index dd2599bad63..3b14faec511 100644 --- a/libgfortran/generated/maxval_r4.c +++ b/libgfortran/generated/maxval_r4.c @@ -60,11 +60,11 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c index 9b847390c1f..280d89ed8cf 100644 --- a/libgfortran/generated/maxval_r8.c +++ b/libgfortran/generated/maxval_r8.c @@ -60,11 +60,11 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc0_16_i1.c b/libgfortran/generated/minloc0_16_i1.c index 05f02de335b..8d2ab4c3aa3 100644 --- a/libgfortran/generated/minloc0_16_i1.c +++ b/libgfortran/generated/minloc0_16_i1.c @@ -55,8 +55,9 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_i1 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i16.c b/libgfortran/generated/minloc0_16_i16.c index 2f2a5339fb8..020de2374fa 100644 --- a/libgfortran/generated/minloc0_16_i16.c +++ b/libgfortran/generated/minloc0_16_i16.c @@ -55,8 +55,9 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i2.c b/libgfortran/generated/minloc0_16_i2.c index b47a82874a7..366832a5085 100644 --- a/libgfortran/generated/minloc0_16_i2.c +++ b/libgfortran/generated/minloc0_16_i2.c @@ -55,8 +55,9 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_i2 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i4.c b/libgfortran/generated/minloc0_16_i4.c index c4f46a47d24..7e0c3307c2e 100644 --- a/libgfortran/generated/minloc0_16_i4.c +++ b/libgfortran/generated/minloc0_16_i4.c @@ -55,8 +55,9 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_i4 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_i8.c b/libgfortran/generated/minloc0_16_i8.c index 7da6932ebaa..65da3f7ae15 100644 --- a/libgfortran/generated/minloc0_16_i8.c +++ b/libgfortran/generated/minloc0_16_i8.c @@ -55,8 +55,9 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_i8 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r10.c b/libgfortran/generated/minloc0_16_r10.c index 3f27660eb58..47345e0c57a 100644 --- a/libgfortran/generated/minloc0_16_r10.c +++ b/libgfortran/generated/minloc0_16_r10.c @@ -55,8 +55,9 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_r10 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r16.c b/libgfortran/generated/minloc0_16_r16.c index 10355a4e7e1..4ee57c04a5d 100644 --- a/libgfortran/generated/minloc0_16_r16.c +++ b/libgfortran/generated/minloc0_16_r16.c @@ -55,8 +55,9 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_r16 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r4.c b/libgfortran/generated/minloc0_16_r4.c index c7e5397b4d7..3d89690c02d 100644 --- a/libgfortran/generated/minloc0_16_r4.c +++ b/libgfortran/generated/minloc0_16_r4.c @@ -55,8 +55,9 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_r4 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_16_r8.c b/libgfortran/generated/minloc0_16_r8.c index 4be08a0a566..88fccec6046 100644 --- a/libgfortran/generated/minloc0_16_r8.c +++ b/libgfortran/generated/minloc0_16_r8.c @@ -55,8 +55,9 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -67,11 +68,11 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -213,7 +215,7 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } @@ -375,7 +376,7 @@ sminloc0_16_r8 (gfc_array_i16 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i1.c b/libgfortran/generated/minloc0_4_i1.c index 5c3ad2f9e42..2026f305aab 100644 --- a/libgfortran/generated/minloc0_4_i1.c +++ b/libgfortran/generated/minloc0_4_i1.c @@ -55,8 +55,9 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_i1 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i16.c b/libgfortran/generated/minloc0_4_i16.c index 23a0a5ae492..9ca27209be3 100644 --- a/libgfortran/generated/minloc0_4_i16.c +++ b/libgfortran/generated/minloc0_4_i16.c @@ -55,8 +55,9 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_i16 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i2.c b/libgfortran/generated/minloc0_4_i2.c index 126b0db4593..3e70ab9665d 100644 --- a/libgfortran/generated/minloc0_4_i2.c +++ b/libgfortran/generated/minloc0_4_i2.c @@ -55,8 +55,9 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_i2 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i4.c b/libgfortran/generated/minloc0_4_i4.c index b5a18f1dd0e..8b8cd3fece6 100644 --- a/libgfortran/generated/minloc0_4_i4.c +++ b/libgfortran/generated/minloc0_4_i4.c @@ -55,8 +55,9 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_i4 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_i8.c b/libgfortran/generated/minloc0_4_i8.c index 67ed089a9ca..4e3580c9920 100644 --- a/libgfortran/generated/minloc0_4_i8.c +++ b/libgfortran/generated/minloc0_4_i8.c @@ -55,8 +55,9 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_i8 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r10.c b/libgfortran/generated/minloc0_4_r10.c index 900a67b493b..9ca902db957 100644 --- a/libgfortran/generated/minloc0_4_r10.c +++ b/libgfortran/generated/minloc0_4_r10.c @@ -55,8 +55,9 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_r10 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r16.c b/libgfortran/generated/minloc0_4_r16.c index d76a413f4f5..9f042ed370b 100644 --- a/libgfortran/generated/minloc0_4_r16.c +++ b/libgfortran/generated/minloc0_4_r16.c @@ -55,8 +55,9 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_r16 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r4.c b/libgfortran/generated/minloc0_4_r4.c index c042bebd7e9..1b39f68dd9b 100644 --- a/libgfortran/generated/minloc0_4_r4.c +++ b/libgfortran/generated/minloc0_4_r4.c @@ -55,8 +55,9 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_r4 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_4_r8.c b/libgfortran/generated/minloc0_4_r8.c index 1ad97595315..79182ded766 100644 --- a/libgfortran/generated/minloc0_4_r8.c +++ b/libgfortran/generated/minloc0_4_r8.c @@ -55,8 +55,9 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -67,11 +68,11 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -213,7 +215,7 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } @@ -375,7 +376,7 @@ sminloc0_4_r8 (gfc_array_i4 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i1.c b/libgfortran/generated/minloc0_8_i1.c index f2205d19a26..53e0834c0ea 100644 --- a/libgfortran/generated/minloc0_8_i1.c +++ b/libgfortran/generated/minloc0_8_i1.c @@ -55,8 +55,9 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_i1 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i16.c b/libgfortran/generated/minloc0_8_i16.c index 142eab6a798..5ac3cfd4f1b 100644 --- a/libgfortran/generated/minloc0_8_i16.c +++ b/libgfortran/generated/minloc0_8_i16.c @@ -55,8 +55,9 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_i16 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i2.c b/libgfortran/generated/minloc0_8_i2.c index 1ab286f8b3b..0895df3f6d5 100644 --- a/libgfortran/generated/minloc0_8_i2.c +++ b/libgfortran/generated/minloc0_8_i2.c @@ -55,8 +55,9 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_i2 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i4.c b/libgfortran/generated/minloc0_8_i4.c index 36bbdf51ac2..f68ef678871 100644 --- a/libgfortran/generated/minloc0_8_i4.c +++ b/libgfortran/generated/minloc0_8_i4.c @@ -55,8 +55,9 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_i4 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_i8.c b/libgfortran/generated/minloc0_8_i8.c index de0a2df6830..a48b08c98af 100644 --- a/libgfortran/generated/minloc0_8_i8.c +++ b/libgfortran/generated/minloc0_8_i8.c @@ -55,8 +55,9 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_i8 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r10.c b/libgfortran/generated/minloc0_8_r10.c index 8de2bb408de..21da22756f7 100644 --- a/libgfortran/generated/minloc0_8_r10.c +++ b/libgfortran/generated/minloc0_8_r10.c @@ -55,8 +55,9 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_r10 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r16.c b/libgfortran/generated/minloc0_8_r16.c index 3b39bfd7df6..e0e49d52b2f 100644 --- a/libgfortran/generated/minloc0_8_r16.c +++ b/libgfortran/generated/minloc0_8_r16.c @@ -55,8 +55,9 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_r16 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r4.c b/libgfortran/generated/minloc0_8_r4.c index 1bf2c86c0bf..ab2bb3f14fe 100644 --- a/libgfortran/generated/minloc0_8_r4.c +++ b/libgfortran/generated/minloc0_8_r4.c @@ -55,8 +55,9 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_r4 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc0_8_r8.c b/libgfortran/generated/minloc0_8_r8.c index b256fcd593f..5537dfeac26 100644 --- a/libgfortran/generated/minloc0_8_r8.c +++ b/libgfortran/generated/minloc0_8_r8.c @@ -55,8 +55,9 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -67,11 +68,11 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -196,8 +197,9 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -213,7 +215,7 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -226,12 +228,12 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -364,8 +366,7 @@ sminloc0_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } @@ -375,7 +376,7 @@ sminloc0_8_r8 (gfc_array_i8 * const restrict retarray, "MINLOC"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = 0 ; diff --git a/libgfortran/generated/minloc1_16_i1.c b/libgfortran/generated/minloc1_16_i1.c index b9adbd5ad96..9b2ea68a0f2 100644 --- a/libgfortran/generated/minloc1_16_i1.c +++ b/libgfortran/generated/minloc1_16_i1.c @@ -61,11 +61,11 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_i16.c b/libgfortran/generated/minloc1_16_i16.c index 89fa4231df9..234906d6818 100644 --- a/libgfortran/generated/minloc1_16_i16.c +++ b/libgfortran/generated/minloc1_16_i16.c @@ -61,11 +61,11 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_i2.c b/libgfortran/generated/minloc1_16_i2.c index 1da5f561e20..3fc5c014879 100644 --- a/libgfortran/generated/minloc1_16_i2.c +++ b/libgfortran/generated/minloc1_16_i2.c @@ -61,11 +61,11 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c index e31e2ed7785..e2d8d71e6a8 100644 --- a/libgfortran/generated/minloc1_16_i4.c +++ b/libgfortran/generated/minloc1_16_i4.c @@ -61,11 +61,11 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c index 9f67e61f9fb..cff3f1fd159 100644 --- a/libgfortran/generated/minloc1_16_i8.c +++ b/libgfortran/generated/minloc1_16_i8.c @@ -61,11 +61,11 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c index 6ce07fb1ff1..9d4349d6185 100644 --- a/libgfortran/generated/minloc1_16_r10.c +++ b/libgfortran/generated/minloc1_16_r10.c @@ -61,11 +61,11 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c index 10fdc85390e..8eeef24cc03 100644 --- a/libgfortran/generated/minloc1_16_r16.c +++ b/libgfortran/generated/minloc1_16_r16.c @@ -61,11 +61,11 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c index a7c948c14cb..58bb8fa75e7 100644 --- a/libgfortran/generated/minloc1_16_r4.c +++ b/libgfortran/generated/minloc1_16_r4.c @@ -61,11 +61,11 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c index 4800348a20d..3d0ae6aa175 100644 --- a/libgfortran/generated/minloc1_16_r8.c +++ b/libgfortran/generated/minloc1_16_r8.c @@ -61,11 +61,11 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_i1.c b/libgfortran/generated/minloc1_4_i1.c index 4597366c213..a7522005385 100644 --- a/libgfortran/generated/minloc1_4_i1.c +++ b/libgfortran/generated/minloc1_4_i1.c @@ -61,11 +61,11 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c index 585d13a0dd8..d6162652237 100644 --- a/libgfortran/generated/minloc1_4_i16.c +++ b/libgfortran/generated/minloc1_4_i16.c @@ -61,11 +61,11 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_i2.c b/libgfortran/generated/minloc1_4_i2.c index ee3e3d97caa..ca416e16684 100644 --- a/libgfortran/generated/minloc1_4_i2.c +++ b/libgfortran/generated/minloc1_4_i2.c @@ -61,11 +61,11 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c index a8ecfb032e4..b06db76f110 100644 --- a/libgfortran/generated/minloc1_4_i4.c +++ b/libgfortran/generated/minloc1_4_i4.c @@ -61,11 +61,11 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c index c0622929d4f..5a4f9fcbded 100644 --- a/libgfortran/generated/minloc1_4_i8.c +++ b/libgfortran/generated/minloc1_4_i8.c @@ -61,11 +61,11 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c index 7487ad564f2..bb09c598e6e 100644 --- a/libgfortran/generated/minloc1_4_r10.c +++ b/libgfortran/generated/minloc1_4_r10.c @@ -61,11 +61,11 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c index e44c5152e98..a5cce356acc 100644 --- a/libgfortran/generated/minloc1_4_r16.c +++ b/libgfortran/generated/minloc1_4_r16.c @@ -61,11 +61,11 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c index cf16c40e498..4ffdcdf8b60 100644 --- a/libgfortran/generated/minloc1_4_r4.c +++ b/libgfortran/generated/minloc1_4_r4.c @@ -61,11 +61,11 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c index 44ac2d72464..5b62a046318 100644 --- a/libgfortran/generated/minloc1_4_r8.c +++ b/libgfortran/generated/minloc1_4_r8.c @@ -61,11 +61,11 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_i1.c b/libgfortran/generated/minloc1_8_i1.c index 68a09ff0ea2..512cbd08e48 100644 --- a/libgfortran/generated/minloc1_8_i1.c +++ b/libgfortran/generated/minloc1_8_i1.c @@ -61,11 +61,11 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c index 7b38113b506..60f0cc51710 100644 --- a/libgfortran/generated/minloc1_8_i16.c +++ b/libgfortran/generated/minloc1_8_i16.c @@ -61,11 +61,11 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_i2.c b/libgfortran/generated/minloc1_8_i2.c index 43b1aa6b7b4..e320730d49f 100644 --- a/libgfortran/generated/minloc1_8_i2.c +++ b/libgfortran/generated/minloc1_8_i2.c @@ -61,11 +61,11 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c index 921c4438800..baabf2abed1 100644 --- a/libgfortran/generated/minloc1_8_i4.c +++ b/libgfortran/generated/minloc1_8_i4.c @@ -61,11 +61,11 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c index 2484e404f31..2ca177c2bd9 100644 --- a/libgfortran/generated/minloc1_8_i8.c +++ b/libgfortran/generated/minloc1_8_i8.c @@ -61,11 +61,11 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c index 270ce0f03d3..02a647ce5fe 100644 --- a/libgfortran/generated/minloc1_8_r10.c +++ b/libgfortran/generated/minloc1_8_r10.c @@ -61,11 +61,11 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c index 039154d10a6..1bcb096ac45 100644 --- a/libgfortran/generated/minloc1_8_r16.c +++ b/libgfortran/generated/minloc1_8_r16.c @@ -61,11 +61,11 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c index 0478a235ba3..266cd265fc5 100644 --- a/libgfortran/generated/minloc1_8_r4.c +++ b/libgfortran/generated/minloc1_8_r4.c @@ -61,11 +61,11 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c index 132c19f2964..d7fd1822090 100644 --- a/libgfortran/generated/minloc1_8_r8.c +++ b/libgfortran/generated/minloc1_8_r8.c @@ -61,11 +61,11 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -244,7 +245,7 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -255,13 +256,13 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -270,8 +271,8 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -280,23 +281,24 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -325,7 +327,7 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -467,23 +469,23 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -521,7 +523,7 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_i1.c b/libgfortran/generated/minval_i1.c index 3c5aeff2bf5..ddf4e43eb93 100644 --- a/libgfortran/generated/minval_i1.c +++ b/libgfortran/generated/minval_i1.c @@ -60,11 +60,11 @@ minval_i1 (gfc_array_i1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c index e286a77a7c9..7c877b2b784 100644 --- a/libgfortran/generated/minval_i16.c +++ b/libgfortran/generated/minval_i16.c @@ -60,11 +60,11 @@ minval_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_i2.c b/libgfortran/generated/minval_i2.c index b446fb4dcd6..897e56f5cf2 100644 --- a/libgfortran/generated/minval_i2.c +++ b/libgfortran/generated/minval_i2.c @@ -60,11 +60,11 @@ minval_i2 (gfc_array_i2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_2)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c index 4a977d2ef01..c9b8b5019a6 100644 --- a/libgfortran/generated/minval_i4.c +++ b/libgfortran/generated/minval_i4.c @@ -60,11 +60,11 @@ minval_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c index 43210aaac37..03e4d7ea5d3 100644 --- a/libgfortran/generated/minval_i8.c +++ b/libgfortran/generated/minval_i8.c @@ -60,11 +60,11 @@ minval_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c index 6bcbce31527..360443ec65c 100644 --- a/libgfortran/generated/minval_r10.c +++ b/libgfortran/generated/minval_r10.c @@ -60,11 +60,11 @@ minval_r10 (gfc_array_r10 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_10)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c index 4f37618e227..b854e58759c 100644 --- a/libgfortran/generated/minval_r16.c +++ b/libgfortran/generated/minval_r16.c @@ -60,11 +60,11 @@ minval_r16 (gfc_array_r16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c index 6a2b2dd1dca..f3ff70bd1e3 100644 --- a/libgfortran/generated/minval_r4.c +++ b/libgfortran/generated/minval_r4.c @@ -60,11 +60,11 @@ minval_r4 (gfc_array_r4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c index f9d3e77ba33..0debd4ca286 100644 --- a/libgfortran/generated/minval_r8.c +++ b/libgfortran/generated/minval_r8.c @@ -60,11 +60,11 @@ minval_r8 (gfc_array_r8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ minval_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ minval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ minval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -236,7 +237,7 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -247,13 +248,13 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -262,8 +263,8 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -272,23 +273,24 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -317,7 +319,7 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -454,23 +456,23 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -508,7 +510,7 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/norm2_r10.c b/libgfortran/generated/norm2_r10.c index 0d37751fc58..5d3457e442c 100644 --- a/libgfortran/generated/norm2_r10.c +++ b/libgfortran/generated/norm2_r10.c @@ -64,11 +64,11 @@ norm2_r10 (gfc_array_r10 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ norm2_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -85,23 +85,24 @@ norm2_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_10)); if (alloc_size == 0) @@ -128,7 +129,7 @@ norm2_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/norm2_r16.c b/libgfortran/generated/norm2_r16.c index 25af99a4c3a..cfe0edd0ba5 100644 --- a/libgfortran/generated/norm2_r16.c +++ b/libgfortran/generated/norm2_r16.c @@ -68,11 +68,11 @@ norm2_r16 (gfc_array_r16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -80,7 +80,7 @@ norm2_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -89,23 +89,24 @@ norm2_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_16)); if (alloc_size == 0) @@ -132,7 +133,7 @@ norm2_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/norm2_r4.c b/libgfortran/generated/norm2_r4.c index 5e86494e6df..92dfcfd02da 100644 --- a/libgfortran/generated/norm2_r4.c +++ b/libgfortran/generated/norm2_r4.c @@ -64,11 +64,11 @@ norm2_r4 (gfc_array_r4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ norm2_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -85,23 +85,24 @@ norm2_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_4)); if (alloc_size == 0) @@ -128,7 +129,7 @@ norm2_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/norm2_r8.c b/libgfortran/generated/norm2_r8.c index e52092d8c27..2a6b535ebf9 100644 --- a/libgfortran/generated/norm2_r8.c +++ b/libgfortran/generated/norm2_r8.c @@ -64,11 +64,11 @@ norm2_r8 (gfc_array_r8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -76,7 +76,7 @@ norm2_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -85,23 +85,24 @@ norm2_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_8)); if (alloc_size == 0) @@ -128,7 +129,7 @@ norm2_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/pack_c10.c b/libgfortran/generated/pack_c10.c index 05ca3b1e321..24a47180573 100644 --- a/libgfortran/generated/pack_c10.c +++ b/libgfortran/generated/pack_c10.c @@ -103,7 +103,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_COMPLEX_10)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_c16.c b/libgfortran/generated/pack_c16.c index 85b5c3554f5..636a644e057 100644 --- a/libgfortran/generated/pack_c16.c +++ b/libgfortran/generated/pack_c16.c @@ -103,7 +103,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_COMPLEX_16)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_c4.c b/libgfortran/generated/pack_c4.c index fbb2c541385..1ef4a8facf2 100644 --- a/libgfortran/generated/pack_c4.c +++ b/libgfortran/generated/pack_c4.c @@ -103,7 +103,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_COMPLEX_4)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_c8.c b/libgfortran/generated/pack_c8.c index 27ef6c72205..233f9629548 100644 --- a/libgfortran/generated/pack_c8.c +++ b/libgfortran/generated/pack_c8.c @@ -103,7 +103,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_COMPLEX_8)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i1.c b/libgfortran/generated/pack_i1.c index 0695d198a12..a1414fb9592 100644 --- a/libgfortran/generated/pack_i1.c +++ b/libgfortran/generated/pack_i1.c @@ -103,7 +103,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_INTEGER_1)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i16.c b/libgfortran/generated/pack_i16.c index 43c5f82751a..affff3fb0d5 100644 --- a/libgfortran/generated/pack_i16.c +++ b/libgfortran/generated/pack_i16.c @@ -103,7 +103,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_INTEGER_16)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i2.c b/libgfortran/generated/pack_i2.c index 909e253f96b..92753d384a8 100644 --- a/libgfortran/generated/pack_i2.c +++ b/libgfortran/generated/pack_i2.c @@ -103,7 +103,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_INTEGER_2)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i4.c b/libgfortran/generated/pack_i4.c index 7ebb5682c97..2f8d128838f 100644 --- a/libgfortran/generated/pack_i4.c +++ b/libgfortran/generated/pack_i4.c @@ -103,7 +103,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_INTEGER_4)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_i8.c b/libgfortran/generated/pack_i8.c index b7d2af86495..8235b1c948c 100644 --- a/libgfortran/generated/pack_i8.c +++ b/libgfortran/generated/pack_i8.c @@ -103,7 +103,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_INTEGER_8)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r10.c b/libgfortran/generated/pack_r10.c index dc9bc61d58f..8cf1454ab06 100644 --- a/libgfortran/generated/pack_r10.c +++ b/libgfortran/generated/pack_r10.c @@ -103,7 +103,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_REAL_10)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r16.c b/libgfortran/generated/pack_r16.c index bc1886917d1..236f93afd74 100644 --- a/libgfortran/generated/pack_r16.c +++ b/libgfortran/generated/pack_r16.c @@ -103,7 +103,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_REAL_16)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r4.c b/libgfortran/generated/pack_r4.c index c03604cff69..01a9093b646 100644 --- a/libgfortran/generated/pack_r4.c +++ b/libgfortran/generated/pack_r4.c @@ -103,7 +103,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_REAL_4)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/pack_r8.c b/libgfortran/generated/pack_r8.c index baf4582af9a..56ea2df1cf5 100644 --- a/libgfortran/generated/pack_r8.c +++ b/libgfortran/generated/pack_r8.c @@ -103,7 +103,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -125,8 +125,8 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -163,7 +163,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof (GFC_REAL_8)); ret->offset = 0; @@ -186,7 +186,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -239,7 +239,7 @@ pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/generated/parity_l1.c b/libgfortran/generated/parity_l1.c index c87007d804e..f4f5b4b5bdd 100644 --- a/libgfortran/generated/parity_l1.c +++ b/libgfortran/generated/parity_l1.c @@ -61,11 +61,11 @@ parity_l1 (gfc_array_l1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ parity_l1 (gfc_array_l1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ parity_l1 (gfc_array_l1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_LOGICAL_1)); if (alloc_size == 0) @@ -125,7 +126,7 @@ parity_l1 (gfc_array_l1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/parity_l16.c b/libgfortran/generated/parity_l16.c index dd31abb3f02..6c6faf94a7a 100644 --- a/libgfortran/generated/parity_l16.c +++ b/libgfortran/generated/parity_l16.c @@ -61,11 +61,11 @@ parity_l16 (gfc_array_l16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ parity_l16 (gfc_array_l16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ parity_l16 (gfc_array_l16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_LOGICAL_16)); if (alloc_size == 0) @@ -125,7 +126,7 @@ parity_l16 (gfc_array_l16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/parity_l2.c b/libgfortran/generated/parity_l2.c index 796dbdadd45..4dba967f2b0 100644 --- a/libgfortran/generated/parity_l2.c +++ b/libgfortran/generated/parity_l2.c @@ -61,11 +61,11 @@ parity_l2 (gfc_array_l2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ parity_l2 (gfc_array_l2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ parity_l2 (gfc_array_l2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_LOGICAL_2)); if (alloc_size == 0) @@ -125,7 +126,7 @@ parity_l2 (gfc_array_l2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/parity_l4.c b/libgfortran/generated/parity_l4.c index c373be3b0bf..879c99af218 100644 --- a/libgfortran/generated/parity_l4.c +++ b/libgfortran/generated/parity_l4.c @@ -61,11 +61,11 @@ parity_l4 (gfc_array_l4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ parity_l4 (gfc_array_l4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ parity_l4 (gfc_array_l4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_LOGICAL_4)); if (alloc_size == 0) @@ -125,7 +126,7 @@ parity_l4 (gfc_array_l4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/parity_l8.c b/libgfortran/generated/parity_l8.c index 1f35f4ef629..284765d07c2 100644 --- a/libgfortran/generated/parity_l8.c +++ b/libgfortran/generated/parity_l8.c @@ -61,11 +61,11 @@ parity_l8 (gfc_array_l8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -73,7 +73,7 @@ parity_l8 (gfc_array_l8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -82,23 +82,24 @@ parity_l8 (gfc_array_l8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_LOGICAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_LOGICAL_8)); if (alloc_size == 0) @@ -125,7 +126,7 @@ parity_l8 (gfc_array_l8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c index c641d46c95d..8c2516fbe5b 100644 --- a/libgfortran/generated/product_c10.c +++ b/libgfortran/generated/product_c10.c @@ -60,11 +60,11 @@ product_c10 (gfc_array_c10 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_c10 (gfc_array_c10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_c10 (gfc_array_c10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_10)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_10); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c index 715b732aafc..a6cb285aa6b 100644 --- a/libgfortran/generated/product_c16.c +++ b/libgfortran/generated/product_c16.c @@ -60,11 +60,11 @@ product_c16 (gfc_array_c16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_c16 (gfc_array_c16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_c16 (gfc_array_c16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c index 3df6564d96f..a97e2634526 100644 --- a/libgfortran/generated/product_c4.c +++ b/libgfortran/generated/product_c4.c @@ -60,11 +60,11 @@ product_c4 (gfc_array_c4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_c4 (gfc_array_c4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_c4 (gfc_array_c4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c index 1dfbc030ba3..24dc8b2daee 100644 --- a/libgfortran/generated/product_c8.c +++ b/libgfortran/generated/product_c8.c @@ -60,11 +60,11 @@ product_c8 (gfc_array_c8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_c8 (gfc_array_c8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_c8 (gfc_array_c8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_i1.c b/libgfortran/generated/product_i1.c index 3a059b27f08..8f5d4b40700 100644 --- a/libgfortran/generated/product_i1.c +++ b/libgfortran/generated/product_i1.c @@ -60,11 +60,11 @@ product_i1 (gfc_array_i1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c index 9ad44dc80e4..4d63b3eec60 100644 --- a/libgfortran/generated/product_i16.c +++ b/libgfortran/generated/product_i16.c @@ -60,11 +60,11 @@ product_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_i2.c b/libgfortran/generated/product_i2.c index bb4a87631ee..1eb29aff942 100644 --- a/libgfortran/generated/product_i2.c +++ b/libgfortran/generated/product_i2.c @@ -60,11 +60,11 @@ product_i2 (gfc_array_i2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_2)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c index 778a222a1d0..f38dfa193e7 100644 --- a/libgfortran/generated/product_i4.c +++ b/libgfortran/generated/product_i4.c @@ -60,11 +60,11 @@ product_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c index ae6c93b432c..7c8e2aaf1ba 100644 --- a/libgfortran/generated/product_i8.c +++ b/libgfortran/generated/product_i8.c @@ -60,11 +60,11 @@ product_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c index 91d4ef72693..b857c435630 100644 --- a/libgfortran/generated/product_r10.c +++ b/libgfortran/generated/product_r10.c @@ -60,11 +60,11 @@ product_r10 (gfc_array_r10 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_10)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c index 3ca748cd2f5..4e7748acec4 100644 --- a/libgfortran/generated/product_r16.c +++ b/libgfortran/generated/product_r16.c @@ -60,11 +60,11 @@ product_r16 (gfc_array_r16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c index 5e173e9a424..5499f737e18 100644 --- a/libgfortran/generated/product_r4.c +++ b/libgfortran/generated/product_r4.c @@ -60,11 +60,11 @@ product_r4 (gfc_array_r4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c index 80ab3b4d5ee..2736524c938 100644 --- a/libgfortran/generated/product_r8.c +++ b/libgfortran/generated/product_r8.c @@ -60,11 +60,11 @@ product_r8 (gfc_array_r8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ product_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ product_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ product_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/reshape_c10.c b/libgfortran/generated/reshape_c10.c index bb93959a79d..724e454c857 100644 --- a/libgfortran/generated/reshape_c10.c +++ b/libgfortran/generated/reshape_c10.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_COMPLEX_10) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_c10 (gfc_array_c10 * const restrict, @@ -87,7 +87,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_c10 (gfc_array_c10 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_COMPLEX_10); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_c10 (gfc_array_c10 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_10)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_c16.c b/libgfortran/generated/reshape_c16.c index 4a08fcd21d4..f758ac8bc68 100644 --- a/libgfortran/generated/reshape_c16.c +++ b/libgfortran/generated/reshape_c16.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_COMPLEX_16) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_c16 (gfc_array_c16 * const restrict, @@ -87,7 +87,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_c16 (gfc_array_c16 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_COMPLEX_16); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_c16 (gfc_array_c16 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_16)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_c4.c b/libgfortran/generated/reshape_c4.c index e284ec96453..63d000581ec 100644 --- a/libgfortran/generated/reshape_c4.c +++ b/libgfortran/generated/reshape_c4.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_COMPLEX_4) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_c4 (gfc_array_c4 * const restrict, @@ -87,7 +87,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_c4 (gfc_array_c4 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_COMPLEX_4); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_c4 (gfc_array_c4 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_4)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_c8.c b/libgfortran/generated/reshape_c8.c index fdc1573a546..187bdd039ed 100644 --- a/libgfortran/generated/reshape_c8.c +++ b/libgfortran/generated/reshape_c8.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_COMPLEX_8) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_c8 (gfc_array_c8 * const restrict, @@ -87,7 +87,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_c8 (gfc_array_c8 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_COMPLEX_8); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_c8 (gfc_array_c8 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_8)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_i16.c b/libgfortran/generated/reshape_i16.c index 0adfdcf96c5..adf4a2dafe5 100644 --- a/libgfortran/generated/reshape_i16.c +++ b/libgfortran/generated/reshape_i16.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_INTEGER_16) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_16 (gfc_array_i16 * const restrict, @@ -87,7 +87,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_16 (gfc_array_i16 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_INTEGER_16); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_16 (gfc_array_i16 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_i4.c b/libgfortran/generated/reshape_i4.c index 2b39c554088..b33a9e1f64c 100644 --- a/libgfortran/generated/reshape_i4.c +++ b/libgfortran/generated/reshape_i4.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_INTEGER_4) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_4 (gfc_array_i4 * const restrict, @@ -87,7 +87,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_4 (gfc_array_i4 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_INTEGER_4); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_4 (gfc_array_i4 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_i8.c b/libgfortran/generated/reshape_i8.c index 06cfa295d1e..6b26e7cedbd 100644 --- a/libgfortran/generated/reshape_i8.c +++ b/libgfortran/generated/reshape_i8.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_INTEGER_8) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_8 (gfc_array_i8 * const restrict, @@ -87,7 +87,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_8 (gfc_array_i8 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_INTEGER_8); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_8 (gfc_array_i8 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_r10.c b/libgfortran/generated/reshape_r10.c index d21122c9b15..acf28d0cf28 100644 --- a/libgfortran/generated/reshape_r10.c +++ b/libgfortran/generated/reshape_r10.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_REAL_10) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_r10 (gfc_array_r10 * const restrict, @@ -87,7 +87,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_r10 (gfc_array_r10 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_REAL_10); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_r10 (gfc_array_r10 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_10)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_r16.c b/libgfortran/generated/reshape_r16.c index f9acb2aa188..ffde4331ed4 100644 --- a/libgfortran/generated/reshape_r16.c +++ b/libgfortran/generated/reshape_r16.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_REAL_16) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_r16 (gfc_array_r16 * const restrict, @@ -87,7 +87,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_r16 (gfc_array_r16 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_REAL_16); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_r16 (gfc_array_r16 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_16)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_r4.c b/libgfortran/generated/reshape_r4.c index e0c128ebd98..6858255dbfd 100644 --- a/libgfortran/generated/reshape_r4.c +++ b/libgfortran/generated/reshape_r4.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_REAL_4) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_r4 (gfc_array_r4 * const restrict, @@ -87,7 +87,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_r4 (gfc_array_r4 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_REAL_4); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_r4 (gfc_array_r4 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_4)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/reshape_r8.c b/libgfortran/generated/reshape_r8.c index e36f9457881..f8fbfa1f3bd 100644 --- a/libgfortran/generated/reshape_r8.c +++ b/libgfortran/generated/reshape_r8.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #if defined (HAVE_GFC_REAL_8) -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; extern void reshape_r8 (gfc_array_r8 * const restrict, @@ -87,7 +87,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -99,12 +99,12 @@ reshape_r8 (gfc_array_r8 * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof (GFC_REAL_8); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -116,7 +116,8 @@ reshape_r8 (gfc_array_r8 * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_8)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -130,7 +131,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -193,7 +194,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -212,12 +213,12 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -239,7 +240,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/generated/shape_i1.c b/libgfortran/generated/shape_i1.c index 070ebc2a27d..c9a5d29eefd 100644 --- a/libgfortran/generated/shape_i1.c +++ b/libgfortran/generated/shape_i1.c @@ -47,12 +47,12 @@ shape_1 (gfc_array_i1 * const restrict ret, if (ret->base_addr == NULL) { - GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, rank, sizeof (GFC_INTEGER_1)); ret->offset = 0; ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_1)); } - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; diff --git a/libgfortran/generated/shape_i16.c b/libgfortran/generated/shape_i16.c index 16b0a80d1f5..902e5f79a1d 100644 --- a/libgfortran/generated/shape_i16.c +++ b/libgfortran/generated/shape_i16.c @@ -47,12 +47,12 @@ shape_16 (gfc_array_i16 * const restrict ret, if (ret->base_addr == NULL) { - GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, rank, sizeof (GFC_INTEGER_16)); ret->offset = 0; ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); } - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; diff --git a/libgfortran/generated/shape_i2.c b/libgfortran/generated/shape_i2.c index 2b6c30a3aed..821e712a44e 100644 --- a/libgfortran/generated/shape_i2.c +++ b/libgfortran/generated/shape_i2.c @@ -47,12 +47,12 @@ shape_2 (gfc_array_i2 * const restrict ret, if (ret->base_addr == NULL) { - GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, rank, sizeof (GFC_INTEGER_2)); ret->offset = 0; ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_2)); } - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; diff --git a/libgfortran/generated/shape_i4.c b/libgfortran/generated/shape_i4.c index 40c7d51976f..e9693a2b2e8 100644 --- a/libgfortran/generated/shape_i4.c +++ b/libgfortran/generated/shape_i4.c @@ -47,12 +47,12 @@ shape_4 (gfc_array_i4 * const restrict ret, if (ret->base_addr == NULL) { - GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, rank, sizeof (GFC_INTEGER_4)); ret->offset = 0; ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4)); } - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; diff --git a/libgfortran/generated/shape_i8.c b/libgfortran/generated/shape_i8.c index abc4ab9b212..3ac18149251 100644 --- a/libgfortran/generated/shape_i8.c +++ b/libgfortran/generated/shape_i8.c @@ -47,12 +47,12 @@ shape_8 (gfc_array_i8 * const restrict ret, if (ret->base_addr == NULL) { - GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, rank, sizeof (GFC_INTEGER_8)); ret->offset = 0; ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8)); } - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; diff --git a/libgfortran/generated/spread_c10.c b/libgfortran/generated/spread_c10.c index 1f99f51fbcd..6e40e5de52a 100644 --- a/libgfortran/generated/spread_c10.c +++ b/libgfortran/generated/spread_c10.c @@ -70,11 +70,12 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_COMPLEX_10)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_c10 (gfc_array_c10 *ret, const GFC_COMPLEX_10 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_COMPLEX_10)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_COMPLEX_10)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_c16.c b/libgfortran/generated/spread_c16.c index 76f4e19487e..e3ae85933d0 100644 --- a/libgfortran/generated/spread_c16.c +++ b/libgfortran/generated/spread_c16.c @@ -70,11 +70,12 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_COMPLEX_16)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_c16 (gfc_array_c16 *ret, const GFC_COMPLEX_16 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_COMPLEX_16)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_COMPLEX_16)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_c4.c b/libgfortran/generated/spread_c4.c index c7a47298f9c..20e1c8afa17 100644 --- a/libgfortran/generated/spread_c4.c +++ b/libgfortran/generated/spread_c4.c @@ -70,11 +70,12 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_COMPLEX_4)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_c4 (gfc_array_c4 *ret, const GFC_COMPLEX_4 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_COMPLEX_4)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_COMPLEX_4)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_c8.c b/libgfortran/generated/spread_c8.c index f69160ec20b..c2a30d8c2d8 100644 --- a/libgfortran/generated/spread_c8.c +++ b/libgfortran/generated/spread_c8.c @@ -70,11 +70,12 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_COMPLEX_8)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_c8 (gfc_array_c8 *ret, const GFC_COMPLEX_8 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_COMPLEX_8)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_COMPLEX_8)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i1.c b/libgfortran/generated/spread_i1.c index a9929fe5af5..a8fde30090f 100644 --- a/libgfortran/generated/spread_i1.c +++ b/libgfortran/generated/spread_i1.c @@ -70,11 +70,12 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_INTEGER_1)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_i1 (gfc_array_i1 *ret, const GFC_INTEGER_1 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_INTEGER_1)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_INTEGER_1)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i16.c b/libgfortran/generated/spread_i16.c index c700866df90..360785d4d87 100644 --- a/libgfortran/generated/spread_i16.c +++ b/libgfortran/generated/spread_i16.c @@ -70,11 +70,12 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_INTEGER_16)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_i16 (gfc_array_i16 *ret, const GFC_INTEGER_16 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_INTEGER_16)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_INTEGER_16)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i2.c b/libgfortran/generated/spread_i2.c index a6dd9af2568..18c8831eba5 100644 --- a/libgfortran/generated/spread_i2.c +++ b/libgfortran/generated/spread_i2.c @@ -70,11 +70,12 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_INTEGER_2)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_i2 (gfc_array_i2 *ret, const GFC_INTEGER_2 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_INTEGER_2)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_INTEGER_2)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i4.c b/libgfortran/generated/spread_i4.c index a049a5060fc..343db4c55fd 100644 --- a/libgfortran/generated/spread_i4.c +++ b/libgfortran/generated/spread_i4.c @@ -70,11 +70,12 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_INTEGER_4)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_i4 (gfc_array_i4 *ret, const GFC_INTEGER_4 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_INTEGER_4)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_INTEGER_4)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_i8.c b/libgfortran/generated/spread_i8.c index 93ba107f048..f1d19200637 100644 --- a/libgfortran/generated/spread_i8.c +++ b/libgfortran/generated/spread_i8.c @@ -70,11 +70,12 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_INTEGER_8)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_i8 (gfc_array_i8 *ret, const GFC_INTEGER_8 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_INTEGER_8)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_INTEGER_8)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r10.c b/libgfortran/generated/spread_r10.c index bfb8505f8a0..c4e350dc61f 100644 --- a/libgfortran/generated/spread_r10.c +++ b/libgfortran/generated/spread_r10.c @@ -70,11 +70,12 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_REAL_10)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_r10 (gfc_array_r10 *ret, const GFC_REAL_10 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_REAL_10)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_REAL_10)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r16.c b/libgfortran/generated/spread_r16.c index d7363db1148..6347943426a 100644 --- a/libgfortran/generated/spread_r16.c +++ b/libgfortran/generated/spread_r16.c @@ -70,11 +70,12 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_REAL_16)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_r16 (gfc_array_r16 *ret, const GFC_REAL_16 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_REAL_16)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_REAL_16)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r4.c b/libgfortran/generated/spread_r4.c index f98c3622ad1..c5863a140e0 100644 --- a/libgfortran/generated/spread_r4.c +++ b/libgfortran/generated/spread_r4.c @@ -70,11 +70,12 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_REAL_4)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_r4 (gfc_array_r4 *ret, const GFC_REAL_4 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_REAL_4)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_REAL_4)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/spread_r8.c b/libgfortran/generated/spread_r8.c index c32add29895..f066c46d684 100644 --- a/libgfortran/generated/spread_r8.c +++ b/libgfortran/generated/spread_r8.c @@ -70,11 +70,12 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -82,7 +83,7 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -90,14 +91,14 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof(GFC_REAL_8)); } ret->offset = 0; @@ -125,7 +126,7 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -146,8 +147,8 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -158,7 +159,7 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -166,8 +167,8 @@ spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -246,17 +247,17 @@ spread_scalar_r8 (gfc_array_r8 *ret, const GFC_REAL_8 *source, { ret->base_addr = xmallocarray (ncopies, sizeof (GFC_REAL_8)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof (GFC_REAL_8)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c index 9ab4a66b82d..2e8aa5d5d1d 100644 --- a/libgfortran/generated/sum_c10.c +++ b/libgfortran/generated/sum_c10.c @@ -60,11 +60,11 @@ sum_c10 (gfc_array_c10 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_c10 (gfc_array_c10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_c10 (gfc_array_c10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_10)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_c10 (gfc_array_c10 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_c10 (gfc_array_c10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_c10 (gfc_array_c10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_c10 (gfc_array_c10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_10); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c index b285480858b..79650c7780a 100644 --- a/libgfortran/generated/sum_c16.c +++ b/libgfortran/generated/sum_c16.c @@ -60,11 +60,11 @@ sum_c16 (gfc_array_c16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_c16 (gfc_array_c16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_c16 (gfc_array_c16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_c16 (gfc_array_c16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_c16 (gfc_array_c16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_c16 (gfc_array_c16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_c16 (gfc_array_c16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c index b91ee7f042f..996315e00ac 100644 --- a/libgfortran/generated/sum_c4.c +++ b/libgfortran/generated/sum_c4.c @@ -60,11 +60,11 @@ sum_c4 (gfc_array_c4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_c4 (gfc_array_c4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_c4 (gfc_array_c4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_c4 (gfc_array_c4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_c4 (gfc_array_c4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_c4 (gfc_array_c4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_c4 (gfc_array_c4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c index 01e3f66271f..61d52da5508 100644 --- a/libgfortran/generated/sum_c8.c +++ b/libgfortran/generated/sum_c8.c @@ -60,11 +60,11 @@ sum_c8 (gfc_array_c8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_c8 (gfc_array_c8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_c8 (gfc_array_c8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_c8 (gfc_array_c8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_c8 (gfc_array_c8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_c8 (gfc_array_c8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_c8 (gfc_array_c8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_COMPLEX_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_i1.c b/libgfortran/generated/sum_i1.c index e54159ab946..4e4236ac0a6 100644 --- a/libgfortran/generated/sum_i1.c +++ b/libgfortran/generated/sum_i1.c @@ -60,11 +60,11 @@ sum_i1 (gfc_array_i1 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_i1 (gfc_array_i1 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_i1 (gfc_array_i1 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_i1 (gfc_array_i1 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_1); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c index fa8f05e9359..e2742c4db76 100644 --- a/libgfortran/generated/sum_i16.c +++ b/libgfortran/generated/sum_i16.c @@ -60,11 +60,11 @@ sum_i16 (gfc_array_i16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_i16 (gfc_array_i16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_i16 (gfc_array_i16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_i16 (gfc_array_i16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_i2.c b/libgfortran/generated/sum_i2.c index 76c0bffcf1c..c4cb3062eea 100644 --- a/libgfortran/generated/sum_i2.c +++ b/libgfortran/generated/sum_i2.c @@ -60,11 +60,11 @@ sum_i2 (gfc_array_i2 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_2)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_i2 (gfc_array_i2 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_i2 (gfc_array_i2 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_i2 (gfc_array_i2 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_2); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c index 74033ced4f4..ab6a5bd7dff 100644 --- a/libgfortran/generated/sum_i4.c +++ b/libgfortran/generated/sum_i4.c @@ -60,11 +60,11 @@ sum_i4 (gfc_array_i4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_i4 (gfc_array_i4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_i4 (gfc_array_i4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_i4 (gfc_array_i4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c index a370ac66574..27c63582431 100644 --- a/libgfortran/generated/sum_i8.c +++ b/libgfortran/generated/sum_i8.c @@ -60,11 +60,11 @@ sum_i8 (gfc_array_i8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_i8 (gfc_array_i8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_i8 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_i8 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_INTEGER_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c index f8e1ed22453..892ec21f7b4 100644 --- a/libgfortran/generated/sum_r10.c +++ b/libgfortran/generated/sum_r10.c @@ -60,11 +60,11 @@ sum_r10 (gfc_array_r10 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_10)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_r10 (gfc_array_r10 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_r10 (gfc_array_r10 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_r10 (gfc_array_r10 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_10); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c index 115151f4b07..dedc1472c90 100644 --- a/libgfortran/generated/sum_r16.c +++ b/libgfortran/generated/sum_r16.c @@ -60,11 +60,11 @@ sum_r16 (gfc_array_r16 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_16)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_r16 (gfc_array_r16 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_r16 (gfc_array_r16 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_r16 (gfc_array_r16 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_16); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c index 05e420d0fc0..027f598744f 100644 --- a/libgfortran/generated/sum_r4.c +++ b/libgfortran/generated/sum_r4.c @@ -60,11 +60,11 @@ sum_r4 (gfc_array_r4 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_4)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_r4 (gfc_array_r4 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_r4 (gfc_array_r4 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_r4 (gfc_array_r4 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_4); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c index 64dc4f5d71b..831ed3bb465 100644 --- a/libgfortran/generated/sum_r8.c +++ b/libgfortran/generated/sum_r8.c @@ -60,11 +60,11 @@ sum_r8 (gfc_array_r8 * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -72,7 +72,7 @@ sum_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -81,23 +81,24 @@ sum_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_REAL_8)); if (alloc_size == 0) @@ -124,7 +125,7 @@ sum_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -222,7 +223,7 @@ msum_r8 (gfc_array_r8 * const restrict retarray, mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -233,13 +234,13 @@ msum_r8 (gfc_array_r8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -248,8 +249,8 @@ msum_r8 (gfc_array_r8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -258,23 +259,24 @@ msum_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -303,7 +305,7 @@ msum_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -412,23 +414,23 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (GFC_REAL_8); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -466,7 +468,7 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/generated/transpose_c10.c b/libgfortran/generated/transpose_c10.c index 67f82f863fc..46dfc3e4a56 100644 --- a/libgfortran/generated/transpose_c10.c +++ b/libgfortran/generated/transpose_c10.c @@ -52,13 +52,13 @@ transpose_c10 (gfc_array_c10 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_COMPLEX_10)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_COMPLEX_10)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_COMPLEX_10)); @@ -87,13 +87,13 @@ transpose_c10 (gfc_array_c10 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_c16.c b/libgfortran/generated/transpose_c16.c index 927fa270dfc..3ea5618fd9c 100644 --- a/libgfortran/generated/transpose_c16.c +++ b/libgfortran/generated/transpose_c16.c @@ -52,13 +52,13 @@ transpose_c16 (gfc_array_c16 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_COMPLEX_16)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_COMPLEX_16)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_COMPLEX_16)); @@ -87,13 +87,13 @@ transpose_c16 (gfc_array_c16 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_c4.c b/libgfortran/generated/transpose_c4.c index d8811d0ebc2..2d1cc64fb76 100644 --- a/libgfortran/generated/transpose_c4.c +++ b/libgfortran/generated/transpose_c4.c @@ -52,13 +52,13 @@ transpose_c4 (gfc_array_c4 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_COMPLEX_4)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_COMPLEX_4)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_COMPLEX_4)); @@ -87,13 +87,13 @@ transpose_c4 (gfc_array_c4 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_c8.c b/libgfortran/generated/transpose_c8.c index 40a73e62bb2..7c22c01095b 100644 --- a/libgfortran/generated/transpose_c8.c +++ b/libgfortran/generated/transpose_c8.c @@ -52,13 +52,13 @@ transpose_c8 (gfc_array_c8 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_COMPLEX_8)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_COMPLEX_8)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_COMPLEX_8)); @@ -87,13 +87,13 @@ transpose_c8 (gfc_array_c8 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_i16.c b/libgfortran/generated/transpose_i16.c index 6812003cce0..0c58f8a6f2c 100644 --- a/libgfortran/generated/transpose_i16.c +++ b/libgfortran/generated/transpose_i16.c @@ -52,13 +52,13 @@ transpose_i16 (gfc_array_i16 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_INTEGER_16)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_INTEGER_16)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_INTEGER_16)); @@ -87,13 +87,13 @@ transpose_i16 (gfc_array_i16 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_i4.c b/libgfortran/generated/transpose_i4.c index dbc5d43c2a8..aa7fe15a7e4 100644 --- a/libgfortran/generated/transpose_i4.c +++ b/libgfortran/generated/transpose_i4.c @@ -52,13 +52,13 @@ transpose_i4 (gfc_array_i4 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_INTEGER_4)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_INTEGER_4)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_INTEGER_4)); @@ -87,13 +87,13 @@ transpose_i4 (gfc_array_i4 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_i8.c b/libgfortran/generated/transpose_i8.c index 631eef34126..f936d2944c5 100644 --- a/libgfortran/generated/transpose_i8.c +++ b/libgfortran/generated/transpose_i8.c @@ -52,13 +52,13 @@ transpose_i8 (gfc_array_i8 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_INTEGER_8)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_INTEGER_8)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_INTEGER_8)); @@ -87,13 +87,13 @@ transpose_i8 (gfc_array_i8 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_r10.c b/libgfortran/generated/transpose_r10.c index 8c276133bcc..046390e7048 100644 --- a/libgfortran/generated/transpose_r10.c +++ b/libgfortran/generated/transpose_r10.c @@ -52,13 +52,13 @@ transpose_r10 (gfc_array_r10 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_REAL_10)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_REAL_10)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_REAL_10)); @@ -87,13 +87,13 @@ transpose_r10 (gfc_array_r10 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_r16.c b/libgfortran/generated/transpose_r16.c index 2e4fd24bfc2..5e6e421101a 100644 --- a/libgfortran/generated/transpose_r16.c +++ b/libgfortran/generated/transpose_r16.c @@ -52,13 +52,13 @@ transpose_r16 (gfc_array_r16 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_REAL_16)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_REAL_16)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_REAL_16)); @@ -87,13 +87,13 @@ transpose_r16 (gfc_array_r16 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_r4.c b/libgfortran/generated/transpose_r4.c index d24fa9bb94a..7eb8fa48040 100644 --- a/libgfortran/generated/transpose_r4.c +++ b/libgfortran/generated/transpose_r4.c @@ -52,13 +52,13 @@ transpose_r4 (gfc_array_r4 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_REAL_4)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_REAL_4)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_REAL_4)); @@ -87,13 +87,13 @@ transpose_r4 (gfc_array_r4 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/transpose_r8.c b/libgfortran/generated/transpose_r8.c index 7834aa22f04..809f7e9e606 100644 --- a/libgfortran/generated/transpose_r8.c +++ b/libgfortran/generated/transpose_r8.c @@ -52,13 +52,13 @@ transpose_r8 (gfc_array_r8 * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof (GFC_REAL_8)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof (GFC_REAL_8)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof (GFC_REAL_8)); @@ -87,13 +87,13 @@ transpose_r8 (gfc_array_r8 * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/generated/unpack_c10.c b/libgfortran/generated/unpack_c10.c index fecc83ab10e..7a6a12a94f3 100644 --- a/libgfortran/generated/unpack_c10.c +++ b/libgfortran/generated/unpack_c10.c @@ -66,7 +66,7 @@ unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_10)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_10)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_c16.c b/libgfortran/generated/unpack_c16.c index 499ac4a4b6e..940f3634740 100644 --- a/libgfortran/generated/unpack_c16.c +++ b/libgfortran/generated/unpack_c16.c @@ -66,7 +66,7 @@ unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_16)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_16)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_c4.c b/libgfortran/generated/unpack_c4.c index c59b4c9f5e4..d67b34a7115 100644 --- a/libgfortran/generated/unpack_c4.c +++ b/libgfortran/generated/unpack_c4.c @@ -66,7 +66,7 @@ unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_4)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_4)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_c8.c b/libgfortran/generated/unpack_c8.c index 687a1e7e9b9..c866eb76144 100644 --- a/libgfortran/generated/unpack_c8.c +++ b/libgfortran/generated/unpack_c8.c @@ -66,7 +66,7 @@ unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_8)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_COMPLEX_8)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i1.c b/libgfortran/generated/unpack_i1.c index a6a753001de..fb1b8b06a10 100644 --- a/libgfortran/generated/unpack_i1.c +++ b/libgfortran/generated/unpack_i1.c @@ -66,7 +66,7 @@ unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_1)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_1)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i16.c b/libgfortran/generated/unpack_i16.c index f62548142db..fc46244ccc5 100644 --- a/libgfortran/generated/unpack_i16.c +++ b/libgfortran/generated/unpack_i16.c @@ -66,7 +66,7 @@ unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_16)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_16)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i2.c b/libgfortran/generated/unpack_i2.c index c1a912fa33d..26fe2f8beb3 100644 --- a/libgfortran/generated/unpack_i2.c +++ b/libgfortran/generated/unpack_i2.c @@ -66,7 +66,7 @@ unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_2)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_2)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i4.c b/libgfortran/generated/unpack_i4.c index c9f6a969125..95fa0c94871 100644 --- a/libgfortran/generated/unpack_i4.c +++ b/libgfortran/generated/unpack_i4.c @@ -66,7 +66,7 @@ unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_4)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_4)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_i8.c b/libgfortran/generated/unpack_i8.c index 11970de9113..f3deb78b985 100644 --- a/libgfortran/generated/unpack_i8.c +++ b/libgfortran/generated/unpack_i8.c @@ -66,7 +66,7 @@ unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_8)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_INTEGER_8)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r10.c b/libgfortran/generated/unpack_r10.c index 5320b5d1800..f9be00d3411 100644 --- a/libgfortran/generated/unpack_r10.c +++ b/libgfortran/generated/unpack_r10.c @@ -66,7 +66,7 @@ unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_10)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_10)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r16.c b/libgfortran/generated/unpack_r16.c index c40739ae1aa..17ee8e3884b 100644 --- a/libgfortran/generated/unpack_r16.c +++ b/libgfortran/generated/unpack_r16.c @@ -66,7 +66,7 @@ unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_16)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_16)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r4.c b/libgfortran/generated/unpack_r4.c index 7678285e94c..a4d0d5ee387 100644 --- a/libgfortran/generated/unpack_r4.c +++ b/libgfortran/generated/unpack_r4.c @@ -66,7 +66,7 @@ unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_4)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_4)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/generated/unpack_r8.c b/libgfortran/generated/unpack_r8.c index 4c3be59797d..acc27d86fb5 100644 --- a/libgfortran/generated/unpack_r8.c +++ b/libgfortran/generated/unpack_r8.c @@ -66,7 +66,7 @@ unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -91,11 +91,12 @@ unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_8)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -111,8 +112,8 @@ unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -124,7 +125,7 @@ unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -212,7 +213,7 @@ unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -237,12 +238,13 @@ unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof (GFC_REAL_8)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -258,9 +260,9 @@ unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -274,7 +276,7 @@ unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index ba01f254c80..62dcc9c5113 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1295,6 +1295,18 @@ GFORTRAN_1.8 { _gfortran_transfer_derived; } GFORTRAN_1.7; +GFORTRAN_1.9 { + global: + CFI_address; + CFI_allocate; + CFI_deallocate; + CFI_establish; + CFI_is_contiguous; + CFI_section; + CFI_select_part; + CFI_setpointer; +} GFORTRAN_1.8; + F2C_1.0 { global: _gfortran_f2c_specific__abs_c4; diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c index 5cb2fa6da95..09564b7fb12 100644 --- a/libgfortran/intrinsics/associated.c +++ b/libgfortran/intrinsics/associated.c @@ -37,7 +37,7 @@ 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_TYPE (pointer) != GFC_DESCRIPTOR_TYPE (target)) return 0; rank = GFC_DESCRIPTOR_RANK (pointer); @@ -48,7 +48,7 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target) if (extent != GFC_DESCRIPTOR_EXTENT(target,n)) return 0; - if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1) + if (GFC_DESCRIPTOR_SM (pointer,n) != GFC_DESCRIPTOR_SM (target,n) && extent != 1) return 0; if (extent <= 0) return 0; diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index 90eba0a5e15..73370f6f0a9 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -51,7 +51,7 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, index_type n; index_type arraysize; - index_type type_size; + CFI_type_t type; if (which < 1 || which > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); @@ -63,20 +63,21 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, int i; ret->offset = 0; - ret->dtype = array->dtype; + ret->elem_len = array->elem_len; + ret->type = array->type; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array,i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * - GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret,i-1) + * GFC_DESCRIPTOR_SM (ret,i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -91,98 +92,84 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, if (arraysize == 0) return; - type_size = GFC_DTYPE_TYPE_SIZE (array); + type = GFC_DESCRIPTOR_TYPE (array); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (array) == 1) + type = CFI_type_Integer1; - switch(type_size) + switch(type) { - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_DERIVED_1: + case CFI_type_Integer1: + case CFI_type_Logical1: cshift0_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array, shift, which); return; - case GFC_DTYPE_LOGICAL_2: - case GFC_DTYPE_INTEGER_2: + case CFI_type_Integer2: + case CFI_type_Logical2: cshift0_i2 ((gfc_array_i2 *)ret, (gfc_array_i2 *) array, shift, which); return; - case GFC_DTYPE_LOGICAL_4: - case GFC_DTYPE_INTEGER_4: + case CFI_type_Integer4: + case CFI_type_Logical4: cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift, which); return; - case GFC_DTYPE_LOGICAL_8: - case GFC_DTYPE_INTEGER_8: + case CFI_type_Integer8: + case CFI_type_Logical8: cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift, which); return; #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_LOGICAL_16: - case GFC_DTYPE_INTEGER_16: + case CFI_type_Integer16: + case CFI_type_Logical16: cshift0_i16 ((gfc_array_i16 *)ret, (gfc_array_i16 *) array, shift, which); return; #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: cshift0_r4 ((gfc_array_r4 *)ret, (gfc_array_r4 *) array, shift, which); return; - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: cshift0_r8 ((gfc_array_r8 *)ret, (gfc_array_r8 *) array, shift, which); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_REAL_10 - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: cshift0_r10 ((gfc_array_r10 *)ret, (gfc_array_r10 *) array, shift, which); return; # endif # ifdef HAVE_GFC_REAL_16 - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: cshift0_r16 ((gfc_array_r16 *)ret, (gfc_array_r16 *) array, shift, which); return; # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: cshift0_c4 ((gfc_array_c4 *)ret, (gfc_array_c4 *) array, shift, which); return; - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: cshift0_c8 ((gfc_array_c8 *)ret, (gfc_array_c8 *) array, shift, which); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_COMPLEX_10 - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: cshift0_c10 ((gfc_array_c10 *)ret, (gfc_array_c10 *) array, shift, which); return; # endif # ifdef HAVE_GFC_COMPLEX_16 - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: cshift0_c16 ((gfc_array_c16 *)ret, (gfc_array_c16 *) array, shift, which); return; # endif -#endif default: break; @@ -285,7 +272,6 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, break; } - which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -302,10 +288,10 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -314,8 +300,8 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); n++; } } @@ -409,7 +395,7 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, const GFC_INTEGER_##N *pshift, const GFC_INTEGER_##N *pdim) \ { \ cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \ - GFC_DESCRIPTOR_SIZE (array)); \ + GFC_DESCRIPTOR_ELEM_LEN (array)); \ } \ \ extern void cshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c index 66bcd6f8b2b..a90e31ec9c1 100644 --- a/libgfortran/intrinsics/date_and_time.c +++ b/libgfortran/intrinsics/date_and_time.c @@ -193,9 +193,9 @@ date_and_time (char *__date, char *__time, char *__zone, { index_type len, delta, elt_size; - elt_size = GFC_DESCRIPTOR_SIZE (__values); + elt_size = GFC_DESCRIPTOR_ELEM_LEN (__values); len = GFC_DESCRIPTOR_EXTENT(__values,0); - delta = GFC_DESCRIPTOR_STRIDE(__values,0); + delta = GFC_DESCRIPTOR_SM(__values,0)/elt_size; if (delta == 0) delta = 1; @@ -271,11 +271,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_DIMENSION_SET(avalues->dim[0], 0, 7, 1); + GFC_DESCRIPTOR_TYPE (avalues) = CFI_type_Real4; + GFC_DESCRIPTOR_ELEM_LEN (avalues) = sizeof (GFC_INTEGER_4); + GFC_DIMENSION_SET (avalues->dim[0], 0, 8, sizeof (GFC_REAL_4)); date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0); diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 37da80ba684..162dad44547 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -69,20 +69,21 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, int i; ret->offset = 0; - ret->dtype = array->dtype; + ret->elem_len = array->elem_len; + ret->type = array->type; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array,i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret,i-1) + * GFC_DESCRIPTOR_SM (ret,i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } @@ -109,10 +110,10 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -121,8 +122,8 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); n++; } } @@ -243,7 +244,7 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, const GFC_INTEGER_##N *pdim) \ { \ eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - GFC_DESCRIPTOR_SIZE (array), "\0", 1); \ + GFC_DESCRIPTOR_ELEM_LEN (array), "\0", 1); \ } \ \ extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c index 829a444282e..8be767ae6d9 100644 --- a/libgfortran/intrinsics/eoshift2.c +++ b/libgfortran/intrinsics/eoshift2.c @@ -67,7 +67,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, soffset = 0; roffset = 0; - size = GFC_DESCRIPTOR_SIZE (array); + size = GFC_DESCRIPTOR_ELEM_LEN (array); arraysize = size0 ((array_t *) array); @@ -76,24 +76,25 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, int i; ret->offset = 0; - ret->dtype = array->dtype; + ret->elem_len = array->elem_len; + ret->type = array->type; /* xmallocarray allocates a single byte for zero size. */ ret->base_addr = xmallocarray (arraysize, size); for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array,i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret,i-1) + * GFC_DESCRIPTOR_SM (ret,i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } } else if (unlikely (compile_options.bounds_check)) @@ -117,10 +118,10 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -129,10 +130,10 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); if (bound) - bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + bstride[n] = GFC_DESCRIPTOR_SM(bound,n); else bstride[n] = 0; n++; diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c index bd80f3ddc54..7754ba972e6 100644 --- a/libgfortran/intrinsics/iso_c_binding.c +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -59,14 +59,9 @@ ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in, { f_ptr_out->offset = 0; - /* Set the necessary dtype field for all pointers. */ - f_ptr_out->dtype = 0; - - /* Put in the element size. */ - f_ptr_out->dtype = f_ptr_out->dtype | (elemSize << GFC_DTYPE_SIZE_SHIFT); - /* Set the data type (e.g., BT_INTEGER). */ - f_ptr_out->dtype = f_ptr_out->dtype | (type << GFC_DTYPE_TYPE_SHIFT); + f_ptr_out->type = type; + f_ptr_out->elem_len = elemSize; } /* Use the generic version of c_f_pointer to set common fields. */ @@ -101,9 +96,9 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, f_ptr_out->offset = str; shapeSize = 0; p = shape->base_addr; - size = GFC_DESCRIPTOR_SIZE(shape); + size = GFC_DESCRIPTOR_ELEM_LEN(shape); - source_stride = GFC_DESCRIPTOR_STRIDE_BYTES(shape,0); + source_stride = GFC_DESCRIPTOR_SM(shape,0); /* shape's length (rank of the output array) */ shapeSize = GFC_DESCRIPTOR_EXTENT(shape,0); @@ -158,12 +153,11 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, f_ptr_out->offset *= -1; /* All we know is the rank, so set it, leaving the rest alone. - Make NO assumptions about the state of dtype coming in! If we + Make NO assumptions about the state of type coming in! If we shift right by TYPE_SHIFT bits we'll throw away the existing rank. Then, shift left by the same number to shift in zeros and or with the new rank. */ - f_ptr_out->dtype = ((f_ptr_out->dtype >> GFC_DTYPE_TYPE_SHIFT) - << GFC_DTYPE_TYPE_SHIFT) | shapeSize; + f_ptr_out->type = f_ptr_out->type; } } @@ -182,8 +176,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_d0) (void *c_ptr_in, /* Preserve the size and rank bits, but reset the type. */ if (shape != NULL) { - f_ptr_out->dtype = f_ptr_out->dtype & (~GFC_DTYPE_TYPE_MASK); - f_ptr_out->dtype = f_ptr_out->dtype - | (BT_DERIVED << GFC_DTYPE_TYPE_SHIFT); + f_ptr_out->type = f_ptr_out->type; + f_ptr_out->type = CFI_type_struct; } } diff --git a/libgfortran/intrinsics/move_alloc.c b/libgfortran/intrinsics/move_alloc.c index 942d1117dcd..6b8a2886088 100644 --- a/libgfortran/intrinsics/move_alloc.c +++ b/libgfortran/intrinsics/move_alloc.c @@ -39,15 +39,15 @@ move_alloc (gfc_array_char * from, gfc_array_char * to) for (i = 0; i < GFC_DESCRIPTOR_RANK (from); i++) { - GFC_DIMENSION_SET(to->dim[i],GFC_DESCRIPTOR_LBOUND(from,i), - GFC_DESCRIPTOR_UBOUND(from,i), - GFC_DESCRIPTOR_STRIDE(from,i)); - GFC_DIMENSION_SET(from->dim[i],GFC_DESCRIPTOR_LBOUND(from,i), - GFC_DESCRIPTOR_LBOUND(from,i), 0); + GFC_DIMENSION_SET (to->dim[i],GFC_DESCRIPTOR_LBOUND (from,i), + GFC_DESCRIPTOR_EXTENT (from,i), + GFC_DESCRIPTOR_SM (from,i)); + GFC_DIMENSION_SET (from->dim[i],GFC_DESCRIPTOR_LBOUND (from,i), 0, 0); } to->offset = from->offset; - to->dtype = from->dtype; + to->elem_len = from->elem_len; + to->type = from->type; to->base_addr = from->base_addr; from->base_addr = NULL; } diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c index 5aea3d0e1f6..b2b79bb9069 100644 --- a/libgfortran/intrinsics/pack_generic.c +++ b/libgfortran/intrinsics/pack_generic.c @@ -101,7 +101,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -120,8 +120,10 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); + if (extent[n] <= 0) + mptr = NULL; } if (sstride[0] == 0) sstride[0] = size; @@ -149,7 +151,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET (ret->dim[0], 0, total, size); ret->offset = 0; /* xmallocarray allocates a single byte for zero size. */ @@ -171,7 +173,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); + rstride0 = GFC_DESCRIPTOR_SM(ret,0); if (rstride0 == 0) rstride0 = size; sstride0 = sstride[0]; @@ -224,7 +226,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); + sstride0 = GFC_DESCRIPTOR_SM(vector,0); if (sstride0 == 0) sstride0 = size; @@ -248,163 +250,157 @@ void pack (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_l1 *mask, const gfc_array_char *vector) { - index_type type_size; + CFI_type_t type; index_type size; - type_size = GFC_DTYPE_TYPE_SIZE(array); + type = GFC_DESCRIPTOR_TYPE (array); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (array) == 1) + type = CFI_type_Integer1; - switch(type_size) + switch(type) { - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_DERIVED_1: + case CFI_type_Integer1: + case CFI_type_Logical1: pack_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array, (gfc_array_l1 *) mask, (gfc_array_i1 *) vector); return; - case GFC_DTYPE_LOGICAL_2: - case GFC_DTYPE_INTEGER_2: + case CFI_type_Integer2: + case CFI_type_Logical2: pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, (gfc_array_l1 *) mask, (gfc_array_i2 *) vector); return; - case GFC_DTYPE_LOGICAL_4: - case GFC_DTYPE_INTEGER_4: + case CFI_type_Integer4: + case CFI_type_Logical4: pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array, (gfc_array_l1 *) mask, (gfc_array_i4 *) vector); return; - case GFC_DTYPE_LOGICAL_8: - case GFC_DTYPE_INTEGER_8: + case CFI_type_Integer8: + case CFI_type_Logical8: pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array, (gfc_array_l1 *) mask, (gfc_array_i8 *) vector); return; #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_LOGICAL_16: - case GFC_DTYPE_INTEGER_16: + case CFI_type_Integer16: + case CFI_type_Logical16: pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, (gfc_array_l1 *) mask, (gfc_array_i16 *) vector); return; #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: pack_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) array, (gfc_array_l1 *) mask, (gfc_array_r4 *) vector); return; - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: pack_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) array, (gfc_array_l1 *) mask, (gfc_array_r8 *) vector); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_REAL_10 - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: pack_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) array, (gfc_array_l1 *) mask, (gfc_array_r10 *) vector); return; # endif # ifdef HAVE_GFC_REAL_16 - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: pack_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) array, (gfc_array_l1 *) mask, (gfc_array_r16 *) vector); return; # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: pack_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array, (gfc_array_l1 *) mask, (gfc_array_c4 *) vector); return; - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: pack_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, (gfc_array_l1 *) mask, (gfc_array_c8 *) vector); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_COMPLEX_10 - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: pack_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) array, (gfc_array_l1 *) mask, (gfc_array_c10 *) vector); return; # endif # ifdef HAVE_GFC_COMPLEX_16 - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: pack_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) array, (gfc_array_l1 *) mask, (gfc_array_c16 *) vector); return; # endif -#endif /* For derived types, let's check the actual alignment of the data pointers. If they are aligned, we can safely call the unpack functions. */ - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(array->base_addr) - || (vector && GFC_UNALIGNED_2(vector->base_addr))) - break; - else - { - pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, - (gfc_array_l1 *) mask, (gfc_array_i2 *) vector); - return; - } + case CFI_type_struct: + case CFI_type_other: + switch (GFC_DESCRIPTOR_ELEM_LEN(array)) + { + case 2: + if (GFC_UNALIGNED_2(ret->base_addr) + || GFC_UNALIGNED_2(array->base_addr) + || (vector && GFC_UNALIGNED_2(vector->base_addr))) + break; + else + { + pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, + (gfc_array_l1 *) mask, (gfc_array_i2 *) vector); + return; + } - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(array->base_addr) - || (vector && GFC_UNALIGNED_4(vector->base_addr))) - break; - else - { - pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array, - (gfc_array_l1 *) mask, (gfc_array_i4 *) vector); - return; - } + case 4: + if (GFC_UNALIGNED_4(ret->base_addr) + || GFC_UNALIGNED_4(array->base_addr) + || (vector && GFC_UNALIGNED_4(vector->base_addr))) + break; + else + { + pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array, + (gfc_array_l1 *) mask, (gfc_array_i4 *) vector); + return; + } - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(array->base_addr) - || (vector && GFC_UNALIGNED_8(vector->base_addr))) - break; - else - { - pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array, - (gfc_array_l1 *) mask, (gfc_array_i8 *) vector); - return; - } + case 8: + if (GFC_UNALIGNED_8(ret->base_addr) + || GFC_UNALIGNED_8(array->base_addr) + || (vector && GFC_UNALIGNED_8(vector->base_addr))) + break; + else + { + pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array, + (gfc_array_l1 *) mask, (gfc_array_i8 *) vector); + return; + } #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(array->base_addr) - || (vector && GFC_UNALIGNED_16(vector->base_addr))) - break; - else - { - pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, - (gfc_array_l1 *) mask, (gfc_array_i16 *) vector); - return; - } + case 16: + if (GFC_UNALIGNED_16(ret->base_addr) + || GFC_UNALIGNED_16(array->base_addr) + || (vector && GFC_UNALIGNED_16(vector->base_addr))) + break; + else + { + pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, + (gfc_array_l1 *) mask, (gfc_array_i16 *) vector); + return; + } #endif - + } } - size = GFC_DESCRIPTOR_SIZE (array); + size = GFC_DESCRIPTOR_ELEM_LEN (array); pack_internal (ret, array, mask, vector, size); } @@ -474,7 +470,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, if (extent[n] < 0) extent[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); ssize *= extent[n]; } if (sstride[0] == 0) @@ -518,7 +514,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, } /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0],0,total-1,1); + GFC_DIMENSION_SET (ret->dim[0], 0, total, size); ret->offset = 0; @@ -528,7 +524,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, return; } - rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); + rstride0 = GFC_DESCRIPTOR_SM(ret,0); if (rstride0 == 0) rstride0 = size; rptr = ret->base_addr; @@ -582,7 +578,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); + sstride0 = GFC_DESCRIPTOR_SM(vector,0); if (sstride0 == 0) sstride0 = size; @@ -606,7 +602,7 @@ void pack_s (gfc_array_char *ret, const gfc_array_char *array, const GFC_LOGICAL_4 *mask, const gfc_array_char *vector) { - pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array)); + pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_ELEM_LEN (array)); } diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c index a67c42de1c9..46ce9f5fbf9 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -28,8 +28,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include <assert.h> -typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; -typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray; +typedef CFI_CDESC_TYPE_T(1, index_type) shape_type; +typedef CFI_CDESC_TYPE_T(GFC_MAX_DIMENSIONS, char) parray; static void reshape_internal (parray *ret, parray *source, shape_type *shape, @@ -38,8 +38,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, /* r.* indicates the return array. */ index_type rcount[GFC_MAX_DIMENSIONS]; index_type rextent[GFC_MAX_DIMENSIONS]; - index_type rstride[GFC_MAX_DIMENSIONS]; - index_type rstride0; + index_type rsm[GFC_MAX_DIMENSIONS]; + index_type rsm0; index_type rdim; index_type rsize; index_type rs; @@ -48,15 +48,15 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, /* s.* indicates the source array. */ index_type scount[GFC_MAX_DIMENSIONS]; index_type sextent[GFC_MAX_DIMENSIONS]; - index_type sstride[GFC_MAX_DIMENSIONS]; - index_type sstride0; + index_type ssm[GFC_MAX_DIMENSIONS]; + index_type ssm0; index_type sdim; index_type ssize; const char *sptr; /* p.* indicates the pad array. */ index_type pcount[GFC_MAX_DIMENSIONS]; index_type pextent[GFC_MAX_DIMENSIONS]; - index_type pstride[GFC_MAX_DIMENSIONS]; + index_type psm[GFC_MAX_DIMENSIONS]; index_type pdim; index_type psize; const char *pptr; @@ -65,7 +65,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, int n; int dim; int sempty, pempty, shape_empty; - index_type shape_data[GFC_MAX_DIMENSIONS]; + index_type shape_data[GFC_MAX_DIMENSIONS], tmp_stride; rdim = GFC_DESCRIPTOR_EXTENT(shape,0); if (rdim != GFC_DESCRIPTOR_RANK(ret)) @@ -73,9 +73,10 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, shape_empty = 0; + tmp_stride = GFC_DESCRIPTOR_SM (shape,0)/sizeof (index_type); for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * tmp_stride]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -87,12 +88,12 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, { index_type alloc_size; - rs = 1; + rs = size; for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n],0,rex - 1,rs); + GFC_DIMENSION_SET (ret->dim[n], 0, rex, rs); rs *= rex; } @@ -104,8 +105,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, size); - - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -114,20 +115,20 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, if (pad) { pdim = GFC_DESCRIPTOR_RANK (pad); - psize = 1; + psize = size; pempty = 0; for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); - pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + psm[n] = GFC_DESCRIPTOR_SM (pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT (pad,n); if (pextent[n] <= 0) { pempty = 1; pextent[n] = 0; } - if (psize == pstride[n]) + if (psize == psm[n]) psize *= pextent[n]; else psize = 0; @@ -180,9 +181,10 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, for (n = 0; n < rdim; n++) seen[n] = 0; + tmp_stride = GFC_DESCRIPTOR_SM (order,0)/sizeof (index_type); for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * tmp_stride] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -197,22 +199,24 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, } } - rsize = 1; + rsize = size; + if (order) + tmp_stride = GFC_DESCRIPTOR_SM (order,0)/sizeof (index_type); for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * tmp_stride] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rsm[n] = GFC_DESCRIPTOR_SM(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] != shape_data[dim]) runtime_error ("shape and target do not conform"); - if (rsize == rstride[n]) + if (rsize == rsm[n]) rsize *= rextent[n]; else rsize = 0; @@ -221,12 +225,12 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, } sdim = GFC_DESCRIPTOR_RANK (source); - ssize = 1; + ssize = size; sempty = 0; for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + ssm[n] = GFC_DESCRIPTOR_SM(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { @@ -234,7 +238,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, sextent[n] = 0; } - if (ssize == sstride[n]) + if (ssize == ssm[n]) ssize *= sextent[n]; else ssize = 0; @@ -242,17 +246,14 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, if (rsize != 0 && ssize != 0 && psize != 0) { - rsize *= size; - ssize *= size; - psize *= size; reshape_packed (ret->base_addr, rsize, source->base_addr, ssize, pad ? pad->base_addr : NULL, psize); return; } rptr = ret->base_addr; src = sptr = source->base_addr; - rstride0 = rstride[0] * size; - sstride0 = sstride[0] * size; + rsm0 = rsm[0]; + ssm0 = ssm[0]; if (sempty && pempty) abort (); @@ -267,8 +268,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, { scount[dim] = pcount[dim]; sextent[dim] = pextent[dim]; - sstride[dim] = pstride[dim]; - sstride0 = pstride[0] * size; + ssm[dim] = psm[dim]; + ssm0 = psm[0]; } } @@ -277,8 +278,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, /* Select between the source and pad arrays. */ memcpy(rptr, src, size); /* Advance to the next element. */ - rptr += rstride0; - src += sstride0; + rptr += rsm0; + src += ssm0; rcount[0]++; scount[0]++; @@ -291,7 +292,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, rcount[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - rptr -= rstride[n] * rextent[n] * size; + rptr -= rsm[n] * rextent[n]; n++; if (n == rdim) { @@ -302,7 +303,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, else { rcount[n]++; - rptr += rstride[n] * size; + rptr += rsm[n]; } } @@ -315,7 +316,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, scount[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - src -= sstride[n] * sextent[n] * size; + src -= ssm[n] * sextent[n]; n++; if (n == sdim) { @@ -328,8 +329,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, { scount[dim] = pcount[dim]; sextent[dim] = pextent[dim]; - sstride[dim] = pstride[dim]; - sstride0 = sstride[0] * size; + ssm[dim] = psm[dim]; + ssm0 = ssm[0]; } } /* We now start again from the beginning of the pad array. */ @@ -339,7 +340,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, else { scount[n]++; - src += sstride[n] * size; + src += ssm[n]; } } } @@ -353,7 +354,7 @@ reshape (parray *ret, parray *source, shape_type *shape, parray *pad, shape_type *order) { reshape_internal (ret, source, shape, pad, order, - GFC_DESCRIPTOR_SIZE (source)); + GFC_DESCRIPTOR_ELEM_LEN (source)); } diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c index 2b5cde74fb7..0f838d28da8 100644 --- a/libgfortran/intrinsics/spread_generic.c +++ b/libgfortran/intrinsics/spread_generic.c @@ -53,7 +53,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, index_type ncopies; index_type size; - size = GFC_DESCRIPTOR_SIZE(source); + size = GFC_DESCRIPTOR_ELEM_LEN(source); srank = GFC_DESCRIPTOR_RANK(source); @@ -71,36 +71,37 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, /* The front end has signalled that we need to populate the return array descriptor. */ - size_t ub, stride; + size_t ext, sm; - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; - rs = 1; + rs = size; for (n = 0; n < rrank; n++) { - stride = rs; + sm = rs; if (n == *along - 1) { - ub = ncopies - 1; - rdelta = rs * size; + ext = ncopies; + rdelta = rs; rs *= ncopies; } else { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); - rstride[dim] = rs * size; + sstride[dim] = GFC_DESCRIPTOR_SM(source,dim); + rstride[dim] = rs; - ub = extent[dim]-1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET (ret->dim[n], 0, ext, sm); } ret->offset = 0; - ret->base_addr = xmallocarray (rs, size); + ret->base_addr = xmalloc (rs); if (rs <= 0) return; @@ -124,7 +125,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == *along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + rdelta = GFC_DESCRIPTOR_SM(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -145,8 +146,8 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + sstride[dim] = GFC_DESCRIPTOR_SM(source,dim); + rstride[dim] = GFC_DESCRIPTOR_SM(ret,n); dim++; } } @@ -157,7 +158,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, { if (n == *along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + rdelta = GFC_DESCRIPTOR_SM(ret,n); } else { @@ -165,8 +166,8 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + sstride[dim] = GFC_DESCRIPTOR_SM(source,dim); + rstride[dim] = GFC_DESCRIPTOR_SM(ret,n); dim++; } } @@ -235,7 +236,7 @@ spread_internal_scalar (gfc_array_char *ret, const char *source, char * dest; size_t size; - size = GFC_DESCRIPTOR_SIZE(ret); + size = GFC_DESCRIPTOR_ELEM_LEN(ret); if (GFC_DESCRIPTOR_RANK (ret) != 1) runtime_error ("incorrect destination rank in spread()"); @@ -247,18 +248,19 @@ spread_internal_scalar (gfc_array_char *ret, const char *source, { ret->base_addr = xmallocarray (ncopies, size); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET (ret->dim[0], 0, ncopies, size); } else { - if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + if (ncopies - 1 + > (index_type) ((GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0))) runtime_error ("dim too large in spread()"); } for (n = 0; n < ncopies; n++) { - dest = (char*)(ret->base_addr + n * GFC_DESCRIPTOR_STRIDE_BYTES(ret,0)); + dest = (char*)(ret->base_addr + n * GFC_DESCRIPTOR_SM(ret,0)); memcpy (dest , source, size); } } @@ -271,150 +273,146 @@ void spread (gfc_array_char *ret, const gfc_array_char *source, const index_type *along, const index_type *pncopies) { - index_type type_size; + CFI_type_t type; - type_size = GFC_DTYPE_TYPE_SIZE(ret); - switch(type_size) + type = GFC_DESCRIPTOR_TYPE (ret); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (ret) == 1) + type = CFI_type_Integer1; + + switch(type) { - case GFC_DTYPE_DERIVED_1: - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_INTEGER_1: + case CFI_type_Integer1: + case CFI_type_Logical1: spread_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) source, *along, *pncopies); return; - case GFC_DTYPE_LOGICAL_2: - case GFC_DTYPE_INTEGER_2: + case CFI_type_Integer2: + case CFI_type_Logical2: spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source, *along, *pncopies); return; - case GFC_DTYPE_LOGICAL_4: - case GFC_DTYPE_INTEGER_4: + case CFI_type_Integer4: + case CFI_type_Logical4: spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source, *along, *pncopies); return; - case GFC_DTYPE_LOGICAL_8: - case GFC_DTYPE_INTEGER_8: + case CFI_type_Integer8: + case CFI_type_Logical8: spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source, *along, *pncopies); return; #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_LOGICAL_16: - case GFC_DTYPE_INTEGER_16: + case CFI_type_Integer16: + case CFI_type_Logical16: spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source, *along, *pncopies); return; #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: spread_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) source, *along, *pncopies); return; - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: spread_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) source, *along, *pncopies); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef GFC_HAVE_REAL_10 - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: spread_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) source, *along, *pncopies); return; # endif # ifdef GFC_HAVE_REAL_16 - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: spread_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) source, *along, *pncopies); return; # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: spread_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) source, *along, *pncopies); return; - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: spread_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) source, *along, *pncopies); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef GFC_HAVE_COMPLEX_10 - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: spread_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) source, *along, *pncopies); return; # endif # ifdef GFC_HAVE_COMPLEX_16 - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: spread_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) source, *along, *pncopies); return; # endif -#endif - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source->base_addr)) - break; - else + case CFI_type_struct: + case CFI_type_other: + switch (GFC_DESCRIPTOR_ELEM_LEN(ret)) { - spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source, - *along, *pncopies); + case 2: + if (GFC_UNALIGNED_2(ret->base_addr) + || GFC_UNALIGNED_2(source->base_addr)) + break; + else + { + spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source, + *along, *pncopies); return; - } + } - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source->base_addr)) - break; - else - { - spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source, - *along, *pncopies); + case 4: + if (GFC_UNALIGNED_4(ret->base_addr) + || GFC_UNALIGNED_4(source->base_addr)) + break; + else + { + spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source, + *along, *pncopies); return; - } + } - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source->base_addr)) - break; - else - { - spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source, - *along, *pncopies); + case 8: + if (GFC_UNALIGNED_8(ret->base_addr) + || GFC_UNALIGNED_8(source->base_addr)) + break; + else + { + spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source, + *along, *pncopies); return; - } + } #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(ret->base_addr) - || GFC_UNALIGNED_16(source->base_addr)) - break; - else - { - spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source, - *along, *pncopies); - return; - } + case 16: + if (GFC_UNALIGNED_16(ret->base_addr) + || GFC_UNALIGNED_16(source->base_addr)) + break; + else + { + spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source, + *along, *pncopies); + return; + } #endif + } + break; } spread_internal (ret, source, along, pncopies); @@ -464,151 +462,144 @@ void spread_scalar (gfc_array_char *ret, const char *source, const index_type *along, const index_type *pncopies) { - index_type type_size; + CFI_type_t type; - if (!ret->dtype) + if (!ret->type) runtime_error ("return array missing descriptor in spread()"); - type_size = GFC_DTYPE_TYPE_SIZE(ret); - switch(type_size) + type = GFC_DESCRIPTOR_TYPE (ret); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (ret) == 1) + type = CFI_type_Integer1; + + switch(type) { - case GFC_DTYPE_DERIVED_1: - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_INTEGER_1: + case CFI_type_Integer1: + case CFI_type_Logical1: spread_scalar_i1 ((gfc_array_i1 *) ret, (GFC_INTEGER_1 *) source, *along, *pncopies); return; - case GFC_DTYPE_LOGICAL_2: - case GFC_DTYPE_INTEGER_2: + case CFI_type_Integer2: + case CFI_type_Logical2: spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source, *along, *pncopies); return; - case GFC_DTYPE_LOGICAL_4: - case GFC_DTYPE_INTEGER_4: + case CFI_type_Integer4: + case CFI_type_Logical4: spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source, *along, *pncopies); return; - case GFC_DTYPE_LOGICAL_8: - case GFC_DTYPE_INTEGER_8: + case CFI_type_Integer8: + case CFI_type_Logical8: spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source, *along, *pncopies); return; #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_LOGICAL_16: - case GFC_DTYPE_INTEGER_16: + case CFI_type_Integer16: + case CFI_type_Logical16: spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source, *along, *pncopies); return; #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: spread_scalar_r4 ((gfc_array_r4 *) ret, (GFC_REAL_4 *) source, *along, *pncopies); return; - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: spread_scalar_r8 ((gfc_array_r8 *) ret, (GFC_REAL_8 *) source, *along, *pncopies); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_REAL_10 - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: spread_scalar_r10 ((gfc_array_r10 *) ret, (GFC_REAL_10 *) source, *along, *pncopies); return; # endif # ifdef HAVE_GFC_REAL_16 - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: spread_scalar_r16 ((gfc_array_r16 *) ret, (GFC_REAL_16 *) source, *along, *pncopies); return; # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: spread_scalar_c4 ((gfc_array_c4 *) ret, (GFC_COMPLEX_4 *) source, *along, *pncopies); return; - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: spread_scalar_c8 ((gfc_array_c8 *) ret, (GFC_COMPLEX_8 *) source, *along, *pncopies); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_COMPLEX_10 - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: spread_scalar_c10 ((gfc_array_c10 *) ret, (GFC_COMPLEX_10 *) source, *along, *pncopies); return; # endif # ifdef HAVE_GFC_COMPLEX_16 - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: spread_scalar_c16 ((gfc_array_c16 *) ret, (GFC_COMPLEX_16 *) source, *along, *pncopies); return; # endif -#endif - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source)) - break; - else + case CFI_type_struct: + case CFI_type_other: + switch (GFC_DESCRIPTOR_ELEM_LEN(ret)) { - spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source, - *along, *pncopies); - return; - } + case 2: + if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source)) + break; + else + { + spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source, + *along, *pncopies); + return; + } - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source)) - break; - else - { - spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source, - *along, *pncopies); - return; - } + case 4: + if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source)) + break; + else + { + spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source, + *along, *pncopies); + return; + } + + case 8: + if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source)) + break; + else + { + spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source, + *along, *pncopies); + return; + } - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source)) - break; - else - { - spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source, - *along, *pncopies); - return; - } #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(source)) - break; - else - { - spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source, - *along, *pncopies); - return; - } + case 16: + if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(source)) + break; + else + { + spread_scalar_i16 ((gfc_array_i16 *) ret, + (GFC_INTEGER_16 *) source, *along, *pncopies); + return; + } #endif + } } spread_internal_scalar (ret, source, along, pncopies); @@ -627,7 +618,7 @@ spread_char_scalar (gfc_array_char *ret, const index_type *pncopies, GFC_INTEGER_4 source_length __attribute__((unused))) { - if (!ret->dtype) + if (!ret->type) runtime_error ("return array missing descriptor in spread()"); spread_internal_scalar (ret, source, along, pncopies); } @@ -645,7 +636,7 @@ spread_char4_scalar (gfc_array_char *ret, const index_type *pncopies, GFC_INTEGER_4 source_length __attribute__((unused))) { - if (!ret->dtype) + if (!ret->type) runtime_error ("return array missing descriptor in spread()"); spread_internal_scalar (ret, source, along, pncopies); diff --git a/libgfortran/intrinsics/transpose_generic.c b/libgfortran/intrinsics/transpose_generic.c index 5c623cc1112..98b9138c034 100644 --- a/libgfortran/intrinsics/transpose_generic.c +++ b/libgfortran/intrinsics/transpose_generic.c @@ -48,17 +48,17 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source) assert (GFC_DESCRIPTOR_RANK (source) == 2 && GFC_DESCRIPTOR_RANK (ret) == 2); - size = GFC_DESCRIPTOR_SIZE(ret); + size = GFC_DESCRIPTOR_ELEM_LEN(ret); if (ret->base_addr == NULL) { - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET (ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + size); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET (ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1) * size); ret->base_addr = xmallocarray (size0 ((array_t*)ret), size); ret->offset = 0; @@ -87,13 +87,13 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source) } - sxstride = GFC_DESCRIPTOR_STRIDE_BYTES(source,0); - systride = GFC_DESCRIPTOR_STRIDE_BYTES(source,1); + sxstride = GFC_DESCRIPTOR_SM(source,0); + systride = GFC_DESCRIPTOR_SM(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,1); + rxstride = GFC_DESCRIPTOR_SM(ret,0); + rystride = GFC_DESCRIPTOR_SM(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c index 5eb10ae70da..5dba832f048 100644 --- a/libgfortran/intrinsics/unpack_generic.c +++ b/libgfortran/intrinsics/unpack_generic.c @@ -60,20 +60,20 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, index_type size) { /* r.* indicates the return array. */ - index_type rstride[GFC_MAX_DIMENSIONS]; - index_type rstride0; + index_type rsm[GFC_MAX_DIMENSIONS]; + index_type rsm0; index_type rs; char * restrict rptr; /* v.* indicates the vector array. */ - index_type vstride0; + index_type vsm0; char *vptr; /* f.* indicates the field array. */ - index_type fstride[GFC_MAX_DIMENSIONS]; - index_type fstride0; + index_type fsm[GFC_MAX_DIMENSIONS]; + index_type fsm0; const char *fptr; /* m.* indicates the mask array. */ - index_type mstride[GFC_MAX_DIMENSIONS]; - index_type mstride0; + index_type msm[GFC_MAX_DIMENSIONS]; + index_type msm0; const GFC_LOGICAL_1 *mptr; index_type count[GFC_MAX_DIMENSIONS]; @@ -91,7 +91,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -111,21 +111,21 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, /* The front end has signalled that we need to populate the return array descriptor. */ dim = GFC_DESCRIPTOR_RANK (mask); - rs = 1; + rs = size; for (n = 0; n < dim; n++) { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), rs); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n); - fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n); + rsm[n] = GFC_DESCRIPTOR_SM(ret, n); + fsm[n] = GFC_DESCRIPTOR_SM(field, n); + msm[n] = GFC_DESCRIPTOR_SM(mask, n); rs *= extent[n]; } ret->offset = 0; - ret->base_addr = xmallocarray (rs, size); + ret->base_addr = xmalloc (rs); } else { @@ -135,9 +135,9 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n); - fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n); + rsm[n] = GFC_DESCRIPTOR_SM(ret, n); + fsm[n] = GFC_DESCRIPTOR_SM(field, n); + msm[n] = GFC_DESCRIPTOR_SM(mask, n); } } @@ -147,10 +147,10 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, /* This assert makes sure GCC knows we can access *stride[0] later. */ assert (dim > 0); - vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); - rstride0 = rstride[0]; - fstride0 = fstride[0]; - mstride0 = mstride[0]; + vsm0 = GFC_DESCRIPTOR_SM(vector,0); + rsm0 = rsm[0]; + fsm0 = fsm[0]; + msm0 = msm[0]; rptr = ret->base_addr; fptr = field->base_addr; vptr = vector->base_addr; @@ -161,7 +161,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, { /* From vector. */ memcpy (rptr, vptr, size); - vptr += vstride0; + vptr += vsm0; } else { @@ -169,9 +169,9 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, memcpy (rptr, fptr, size); } /* Advance to the next element. */ - rptr += rstride0; - fptr += fstride0; - mptr += mstride0; + rptr += rsm0; + fptr += fsm0; + mptr += msm0; count[0]++; n = 0; while (count[n] == extent[n]) @@ -181,9 +181,9 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, count[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - rptr -= rstride[n] * extent[n]; - fptr -= fstride[n] * extent[n]; - mptr -= mstride[n] * extent[n]; + rptr -= rsm[n] * extent[n]; + fptr -= fsm[n] * extent[n]; + mptr -= msm[n] * extent[n]; n++; if (n >= dim) { @@ -194,9 +194,9 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, else { count[n]++; - rptr += rstride[n]; - fptr += fstride[n]; - mptr += mstride[n]; + rptr += rsm[n]; + fptr += fsm[n]; + mptr += msm[n]; } } } @@ -210,160 +210,155 @@ void unpack1 (gfc_array_char *ret, const gfc_array_char *vector, const gfc_array_l1 *mask, const gfc_array_char *field) { - index_type type_size; + CFI_type_t type; index_type size; if (unlikely(compile_options.bounds_check)) unpack_bounds (ret, vector, mask, field); - type_size = GFC_DTYPE_TYPE_SIZE (vector); - size = GFC_DESCRIPTOR_SIZE (vector); + size = GFC_DESCRIPTOR_ELEM_LEN (vector); - switch(type_size) + type = GFC_DESCRIPTOR_TYPE (vector); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (vector) == 1) + type = CFI_type_Integer1; + + switch (type) { - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_DERIVED_1: + case CFI_type_Integer1: + case CFI_type_Logical1: unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector, mask, (gfc_array_i1 *) field); return; - case GFC_DTYPE_LOGICAL_2: - case GFC_DTYPE_INTEGER_2: + case CFI_type_Integer2: + case CFI_type_Logical2: unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, mask, (gfc_array_i2 *) field); return; - case GFC_DTYPE_LOGICAL_4: - case GFC_DTYPE_INTEGER_4: + case CFI_type_Integer4: + case CFI_type_Logical4: unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, mask, (gfc_array_i4 *) field); return; - case GFC_DTYPE_LOGICAL_8: - case GFC_DTYPE_INTEGER_8: + case CFI_type_Integer8: + case CFI_type_Logical8: unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, mask, (gfc_array_i8 *) field); return; #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_LOGICAL_16: - case GFC_DTYPE_INTEGER_16: + case CFI_type_Integer16: + case CFI_type_Logical16: unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, mask, (gfc_array_i16 *) field); return; #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: unpack1_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector, mask, (gfc_array_r4 *) field); return; - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: unpack1_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) vector, mask, (gfc_array_r8 *) field); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_REAL_10 - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: unpack1_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector, mask, (gfc_array_r10 *) field); return; # endif # ifdef HAVE_GFC_REAL_16 - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: unpack1_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector, mask, (gfc_array_r16 *) field); return; # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: unpack1_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector, mask, (gfc_array_c4 *) field); return; - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: unpack1_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector, mask, (gfc_array_c8 *) field); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_COMPLEX_10 - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: unpack1_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector, mask, (gfc_array_c10 *) field); return; # endif # ifdef HAVE_GFC_COMPLEX_16 - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: unpack1_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector, mask, (gfc_array_c16 *) field); return; # endif -#endif - - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr) - || GFC_UNALIGNED_2(field->base_addr)) - break; - else - { - unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, - mask, (gfc_array_i2 *) field); - return; - } - - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr) - || GFC_UNALIGNED_4(field->base_addr)) - break; - else - { - unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, - mask, (gfc_array_i4 *) field); - return; - } - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr) - || GFC_UNALIGNED_8(field->base_addr)) - break; - else - { - unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, - mask, (gfc_array_i8 *) field); - return; - } + case CFI_type_struct: + case CFI_type_other: + switch (GFC_DESCRIPTOR_ELEM_LEN(vector)) + { + case 2: + if (GFC_UNALIGNED_2(ret->base_addr) + || GFC_UNALIGNED_2(vector->base_addr) + || GFC_UNALIGNED_2(field->base_addr)) + break; + else + { + unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (gfc_array_i2 *) field); + return; + } + + case 4: + if (GFC_UNALIGNED_4(ret->base_addr) + || GFC_UNALIGNED_4(vector->base_addr) + || GFC_UNALIGNED_4(field->base_addr)) + break; + else + { + unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (gfc_array_i4 *) field); + return; + } + + case 8: + if (GFC_UNALIGNED_8(ret->base_addr) + || GFC_UNALIGNED_8(vector->base_addr) + || GFC_UNALIGNED_8(field->base_addr)) + break; + else + { + unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (gfc_array_i8 *) field); + return; + } #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(ret->base_addr) - || GFC_UNALIGNED_16(vector->base_addr) - || GFC_UNALIGNED_16(field->base_addr)) - break; - else - { - unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, - mask, (gfc_array_i16 *) field); - return; - } + case 16: + if (GFC_UNALIGNED_16(ret->base_addr) + || GFC_UNALIGNED_16(vector->base_addr) + || GFC_UNALIGNED_16(field->base_addr)) + break; + else + { + unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (gfc_array_i16 *) field); + return; + } #endif + } } unpack_internal (ret, vector, mask, field, size); @@ -422,166 +417,158 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector, const gfc_array_l1 *mask, char *field) { gfc_array_char tmp; - - index_type type_size; + CFI_type_t type; if (unlikely(compile_options.bounds_check)) unpack_bounds (ret, vector, mask, NULL); - type_size = GFC_DTYPE_TYPE_SIZE (vector); + type = GFC_DESCRIPTOR_TYPE (vector); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (vector) == 1) + type = CFI_type_Integer1; - switch (type_size) + switch (type) { - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_DERIVED_1: + case CFI_type_Integer1: + case CFI_type_Logical1: unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector, mask, (GFC_INTEGER_1 *) field); return; - case GFC_DTYPE_LOGICAL_2: - case GFC_DTYPE_INTEGER_2: + case CFI_type_Integer2: + case CFI_type_Logical2: unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, mask, (GFC_INTEGER_2 *) field); return; - case GFC_DTYPE_LOGICAL_4: - case GFC_DTYPE_INTEGER_4: + case CFI_type_Integer4: + case CFI_type_Logical4: unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, mask, (GFC_INTEGER_4 *) field); return; - case GFC_DTYPE_LOGICAL_8: - case GFC_DTYPE_INTEGER_8: + case CFI_type_Integer8: + case CFI_type_Logical8: unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, mask, (GFC_INTEGER_8 *) field); return; #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_LOGICAL_16: - case GFC_DTYPE_INTEGER_16: + case CFI_type_Integer16: + case CFI_type_Logical16: unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, mask, (GFC_INTEGER_16 *) field); return; #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: unpack0_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector, mask, (GFC_REAL_4 *) field); return; - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: unpack0_r8 ((gfc_array_r8 *) ret, (gfc_array_r8*) vector, mask, (GFC_REAL_8 *) field); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_REAL_10 - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: unpack0_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector, mask, (GFC_REAL_10 *) field); return; # endif # ifdef HAVE_GFC_REAL_16 - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: unpack0_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector, mask, (GFC_REAL_16 *) field); return; # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: unpack0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector, mask, (GFC_COMPLEX_4 *) field); return; - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: unpack0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector, mask, (GFC_COMPLEX_8 *) field); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # ifdef HAVE_GFC_COMPLEX_10 - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: unpack0_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector, mask, (GFC_COMPLEX_10 *) field); return; # endif # ifdef HAVE_GFC_COMPLEX_16 - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: unpack0_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector, mask, (GFC_COMPLEX_16 *) field); return; # endif -#endif - - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr) - || GFC_UNALIGNED_2(field)) - break; - else - { - unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, - mask, (GFC_INTEGER_2 *) field); - return; - } - - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr) - || GFC_UNALIGNED_4(field)) - break; - else - { - unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, - mask, (GFC_INTEGER_4 *) field); - return; - } - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr) - || GFC_UNALIGNED_8(field)) - break; - else + case CFI_type_struct: + case CFI_type_other: + switch (GFC_DESCRIPTOR_ELEM_LEN(vector)) { - unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, - mask, (GFC_INTEGER_8 *) field); - return; - } + case 2: + if (GFC_UNALIGNED_2(ret->base_addr) + || GFC_UNALIGNED_2(vector->base_addr) + || GFC_UNALIGNED_2(field)) + break; + else + { + unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (GFC_INTEGER_2 *) field); + return; + } + + case 4: + if (GFC_UNALIGNED_4(ret->base_addr) + || GFC_UNALIGNED_4(vector->base_addr) + || GFC_UNALIGNED_4(field)) + break; + else + { + unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (GFC_INTEGER_4 *) field); + return; + } + + case 8: + if (GFC_UNALIGNED_8(ret->base_addr) + || GFC_UNALIGNED_8(vector->base_addr) + || GFC_UNALIGNED_8(field)) + break; + else + { + unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (GFC_INTEGER_8 *) field); + return; + } #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(ret->base_addr) - || GFC_UNALIGNED_16(vector->base_addr) - || GFC_UNALIGNED_16(field)) - break; - else - { - unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, - mask, (GFC_INTEGER_16 *) field); - return; - } + case 16: + if (GFC_UNALIGNED_16(ret->base_addr) + || GFC_UNALIGNED_16(vector->base_addr) + || GFC_UNALIGNED_16(field)) + break; + else + { + unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (GFC_INTEGER_16 *) field); + return; + } #endif - + } } memset (&tmp, 0, sizeof (tmp)); - tmp.dtype = 0; + tmp.type = 0; tmp.base_addr = field; - unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector)); + unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_ELEM_LEN (vector)); } @@ -603,7 +590,7 @@ unpack0_char (gfc_array_char *ret, unpack_bounds (ret, vector, mask, NULL); memset (&tmp, 0, sizeof (tmp)); - tmp.dtype = 0; + tmp.type = 0; tmp.base_addr = field; unpack_internal (ret, vector, mask, &tmp, vector_length); } @@ -627,7 +614,7 @@ unpack0_char4 (gfc_array_char *ret, unpack_bounds (ret, vector, mask, NULL); memset (&tmp, 0, sizeof (tmp)); - tmp.dtype = 0; + tmp.type = 0; tmp.base_addr = field; unpack_internal (ret, vector, mask, &tmp, vector_length * sizeof (gfc_char4_t)); diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index ff75741effd..7c39dee253d 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -154,6 +154,9 @@ typedef struct namelist_type /* Object type. */ bt type; + /* Intrinsic kind. */ + int kind; + /* Object name. */ char * var_name; @@ -169,9 +172,6 @@ typedef struct namelist_type /* Flag to show that a read is to be attempted for this node. */ int touched; - /* Length of intrinsic type in bytes. */ - int len; - /* Rank of the object. */ int var_rank; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index a42f12b7269..6c4ad3f361e 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2843,7 +2843,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, namelist_info * cmp; char * obj_name; int nml_carry; - int len; + int kind; int dim; index_type dlen; index_type m; @@ -2859,29 +2859,11 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, dtp->u.p.repeat_count = 0; eat_spaces (dtp); - len = nl->len; - switch (nl->type) - { - case BT_INTEGER: - case BT_LOGICAL: - dlen = len; - break; - - case BT_REAL: - dlen = size_from_real_kind (len); - break; - - case BT_COMPLEX: - dlen = size_from_complex_kind (len); - break; - - case BT_CHARACTER: - dlen = chigh ? (chigh - clow + 1) : nl->string_length; - break; - - default: - dlen = 0; - } + kind = nl->kind; + if (nl->type == BT_CHARACTER) + dlen = chigh ? (chigh - clow + 1) : nl->string_length; + else + dlen = nl->size; do { @@ -2891,7 +2873,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, for (dim = 0; dim < nl->var_rank; dim++) pdata = (void*)(pdata + (nl->ls[dim].idx - GFC_DESCRIPTOR_LBOUND(nl,dim)) - * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size); + * GFC_DESCRIPTOR_SM(nl,dim)); /* If we are finished with the repeat count, try to read next value. */ @@ -2911,27 +2893,27 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, switch (nl->type) { case BT_INTEGER: - read_integer (dtp, len); + read_integer (dtp, kind); break; case BT_LOGICAL: - read_logical (dtp, len); + read_logical (dtp, kind); break; case BT_CHARACTER: - read_character (dtp, len); + read_character (dtp, kind); break; 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); + read_real (dtp, pdata, kind); memcpy (dtp->u.p.value, pdata, dlen); break; case BT_COMPLEX: /* Same as for REAL, copy back to temp. */ - read_complex (dtp, pdata, len, dlen); + read_complex (dtp, pdata, kind, dlen); memcpy (dtp->u.p.value, pdata, dlen); break; @@ -3365,7 +3347,7 @@ get_name: if (c == '(' && nl->type == BT_CHARACTER) { - descriptor_dimension chd[1] = { {1, clow, nl->string_length} }; + descriptor_dimension chd[1] = { {clow, nl->string_length - clow + 1, 1} }; array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} }; if (!nml_parse_qualifier (dtp, chd, ind, -1, nl->type, diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 98072d0b889..9a73d8d4f3b 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -2330,14 +2330,19 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; - iotype = (bt) GFC_DESCRIPTOR_TYPE (desc); - size = iotype == BT_CHARACTER ? charlen : GFC_DESCRIPTOR_SIZE (desc); + iotype = (bt) (GFC_DESCRIPTOR_TYPE (desc) & CFI_type_mask); + + if (iotype > CFI_type_Character) + internal_error (NULL, "transfer_array(): Bad type"); + + size = iotype == BT_CHARACTER ? charlen + : (index_type) GFC_DESCRIPTOR_ELEM_LEN (desc); rank = GFC_DESCRIPTOR_RANK (desc); for (n = 0; n < rank; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(desc,n); + stride[n] = GFC_DESCRIPTOR_SM(desc,n); extent[n] = GFC_DESCRIPTOR_EXTENT(desc,n); /* If the extent of even one dimension is zero, then the entire @@ -3120,33 +3125,36 @@ init_loop_spec (gfc_array_char *desc, array_loop_spec *ls, { int rank = GFC_DESCRIPTOR_RANK(desc); int i; - gfc_offset index; + gfc_offset index, elem_len; int empty; empty = 0; index = 1; *start_record = 0; - for (i=0; i<rank; i++) + elem_len = GFC_DESCRIPTOR_ELEM_LEN (desc); + if (elem_len <= 0) + return 0; + + for (i=0; i < rank; i++) { ls[i].idx = GFC_DESCRIPTOR_LBOUND(desc,i); ls[i].start = GFC_DESCRIPTOR_LBOUND(desc,i); ls[i].end = GFC_DESCRIPTOR_UBOUND(desc,i); - ls[i].step = GFC_DESCRIPTOR_STRIDE(desc,i); - empty = empty || (GFC_DESCRIPTOR_UBOUND(desc,i) - < GFC_DESCRIPTOR_LBOUND(desc,i)); + ls[i].step = GFC_DESCRIPTOR_SM(desc,i)/elem_len; + empty = empty || (GFC_DESCRIPTOR_EXTENT(desc,i) <= 0); - if (GFC_DESCRIPTOR_STRIDE(desc,i) > 0) + if (GFC_DESCRIPTOR_SM(desc,i) > 0) { index += (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) - * GFC_DESCRIPTOR_STRIDE(desc,i); + * GFC_DESCRIPTOR_SM(desc,i)/elem_len; } else { index -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) - * GFC_DESCRIPTOR_STRIDE(desc,i); + * GFC_DESCRIPTOR_SM(desc,i)/elem_len; *start_record -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) - * GFC_DESCRIPTOR_STRIDE(desc,i); + * GFC_DESCRIPTOR_SM(desc,i)/elem_len; } } @@ -4030,8 +4038,9 @@ 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) + GFC_INTEGER_4 kind, gfc_charlen_type elem_len, + GFC_INTEGER_4 rank, GFC_INTEGER_4 dtype, + void *dtio_sub, void *vtable) { namelist_info *t1 = NULL; namelist_info *nml; @@ -4047,12 +4056,12 @@ set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name, memcpy (nml->var_name, var_name, var_name_len); nml->var_name[var_name_len] = '\0'; - 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->type = (bt) dtype; + nml->kind = kind; + nml->size = (index_type) elem_len; + nml->string_length = nml->type == BT_CHARACTER + ? (index_type) elem_len/kind : 0; + nml->var_rank = rank; if (nml->var_rank > 0) { @@ -4082,34 +4091,37 @@ 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, + GFC_INTEGER_4, 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) + GFC_INTEGER_4 kind, gfc_charlen_type elem_len, + GFC_INTEGER_4 rank, GFC_INTEGER_4 dtype) { - set_nml_var (dtp, var_addr, var_name, len, string_length, - dtype, NULL, NULL); + set_nml_var (dtp, var_addr, var_name, kind, elem_len, + rank, dtype, NULL, NULL); } /* 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, + GFC_INTEGER_4, GFC_INTEGER_4, void *, void *); 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) + GFC_INTEGER_4 kind, gfc_charlen_type elem_len, + GFC_INTEGER_4 rank, GFC_INTEGER_4 dtype, + void *dtio_sub, void *vtable) { - set_nml_var (dtp, var_addr, var_name, len, string_length, - dtype, dtio_sub, vtable); + set_nml_var (dtp, var_addr, var_name, kind, elem_len, + rank, dtype, dtio_sub, vtable); } /* Store the dimensional information for the namelist object. */ @@ -4120,8 +4132,8 @@ export_proto(st_set_nml_var_dim); void st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4 n_dim, - index_type stride, index_type lbound, - index_type ubound) + index_type lower_bound, index_type extent, + index_type sm) { namelist_info * nml; int n; @@ -4130,7 +4142,7 @@ st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4 n_dim, for (nml = dtp->u.p.ionml; nml->next; nml = nml->next); - GFC_DIMENSION_SET(nml->dim[n],lbound,ubound,stride); + GFC_DIMENSION_SET (nml->dim[n],lower_bound, extent, sm); } diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index d4b1bc895ed..09a92dc6efb 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1968,28 +1968,10 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, num = 1; - len = obj->len; - - switch (obj->type) - { - - case BT_REAL: - obj_size = size_from_real_kind (len); - break; - - case BT_COMPLEX: - obj_size = size_from_complex_kind (len); - break; - - case BT_CHARACTER: - obj_size = obj->string_length; - break; - - default: - obj_size = len; - } - - if (obj->var_rank) + len = obj->kind; + if (obj->type == BT_CHARACTER) + obj_size = obj->string_length; + else obj_size = obj->size; /* Set the index vector and count the number of elements. */ diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 79f0d61c8e5..dd621c223e1 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -319,160 +319,104 @@ internal_proto(big_endian); # endif #endif -typedef struct descriptor_dimension -{ - index_type _stride; - 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;\ - descriptor_dimension dim[r];\ -} +#include "ISO_Fortran_binding.h" + +#if GFC_ATTRIBUTE_POINTER != CFI_attribute_pointer \ + || GFC_ATTRIBUTE_ALLOCATABLE != CFI_attribute_allocatable \ + || GFC_ATTRIBUTE_OTHER != CFI_attribute_other \ + || GFC_MAX_DIMENSIONS != CFI_MAX_RANK \ + || GFC_TYPE_INTEGER != CFI_type_Integer \ + || GFC_TYPE_LOGICAL != CFI_type_Logical \ + || GFC_TYPE_REAL != CFI_type_Real \ + || GFC_TYPE_COMPLEX != CFI_type_Complex \ + || GFC_TYPE_CHARACTER != CFI_type_Character \ + || GFC_TYPE_STRUCT != CFI_type_struct \ + || GFC_TYPE_CPTR != CFI_type_cptr \ + || GFC_TYPE_CFUNPTR != CFI_type_cfunptr \ + || GFC_TYPE_OTHER != CFI_type_other \ + || GFC_TYPE_KIND_SHIFT != CFI_type_kind_shift \ + || GFC_TYPE_MASK != CFI_type_mask + choke me +#endif + +typedef CFI_dim_t descriptor_dimension; /* Commonly used array descriptor types. */ -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_1) gfc_array_i1; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_2) gfc_array_i2; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, void) gfc_array_void; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, char) gfc_array_char; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_INTEGER_1) gfc_array_i1; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_INTEGER_2) gfc_array_i2; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8; #ifdef HAVE_GFC_INTEGER_16 -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16; #endif -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8; #ifdef HAVE_GFC_REAL_10 -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10; #endif #ifdef HAVE_GFC_REAL_16 -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16; #endif -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8; #ifdef HAVE_GFC_COMPLEX_10 -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10; #endif #ifdef HAVE_GFC_COMPLEX_16 -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16; #endif -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_1) gfc_array_l1; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_2) gfc_array_l2; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4; -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_1) gfc_array_l1; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_2) gfc_array_l2; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8; #ifdef HAVE_GFC_LOGICAL_16 -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; #endif -#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)->rank) +#define GFC_DESCRIPTOR_TYPE(desc) ((desc)->type) +#define GFC_DESCRIPTOR_ELEM_LEN(desc) ((desc)->elem_len) + +/* This is for getting the size of a type when the type of the + descriptor is known at compile-time. Do not use for string types. */ + +#define GFC_DESCRIPTOR_SIZE_TYPEKNOWN(desc) (sizeof((desc)->base_addr[0])) #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr) -#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) #define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound) -#define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound) -#define GFC_DIMENSION_STRIDE(dim) ((dim)._stride) -#define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim).lower_bound) -#define GFC_DIMENSION_SET(dim,lb,ub,str) \ +#define GFC_DIMENSION_UBOUND(dim) ((dim).lower_bound + (dim).extent - 1) +#define GFC_DIMENSION_EXTENT(dim) ((dim).extent) + +#define GFC_DIMENSION_SET(dim,lb,ext,sm_) \ do \ { \ (dim).lower_bound = lb; \ - (dim)._ubound = ub; \ - (dim)._stride = str; \ + (dim).extent = ext; \ + (dim).sm = sm_; \ } while (0) #define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound) -#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound) -#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \ - - (desc)->dim[i].lower_bound) +#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i].extent) +#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i].extent - 1 \ + + (desc)->dim[i].lower_bound) #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \ - (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) - -#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride) -#define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \ - (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) + (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_ELEM_LEN(desc)) -/* Macros to get both the size and the type with a single masking operation */ +#define GFC_DESCRIPTOR_SM(desc,i) ((desc)->dim[i].sm) +#define GFC_DESCRIPTOR_STRIDE(desc,i) \ + (GFC_DESCRIPTOR_SM(desc,i) / GFC_DESCRIPTOR_ELEM_LEN(desc)) -#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) +/* This is for getting the stride when the type of the descriptor is known at + compile-time, to avoid expensive divisions. Do not use for string + types. */ -#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK) +#define GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(desc,i) \ + ((index_type)(GFC_DESCRIPTOR_SM(desc,i) / GFC_DESCRIPTOR_SIZE_TYPEKNOWN(desc))) -#define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_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 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_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 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) -#endif - -#define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_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 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_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 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT)) -#endif - -#define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_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 ((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 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT)) -#endif - -#define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_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 ((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 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT)) -#endif - -#define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_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 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_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 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ - | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) -#endif /* Macros to determine the alignment of pointers. */ @@ -1336,7 +1280,7 @@ iexport_proto(random_seed_i8); /* size.c */ -typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t; +typedef CFI_CDESC_TYPE_T (GFC_MAX_DIMENSIONS, void) array_t; extern index_type size0 (const array_t * array); iexport_proto(size0); diff --git a/libgfortran/libtool-version b/libgfortran/libtool-version index f787e378b07..712199096eb 100644 --- a/libgfortran/libtool-version +++ b/libgfortran/libtool-version @@ -3,4 +3,4 @@ # This is a separate file so that version updates don't involve re-running # automake. # CURRENT:REVISION:AGE -3:0:0 +4:0:0 diff --git a/libgfortran/m4/bessel.m4 b/libgfortran/m4/bessel.m4 index df481672c51..5e679420723 100644 --- a/libgfortran/m4/bessel.m4 +++ b/libgfortran/m4/bessel.m4 @@ -50,12 +50,12 @@ bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, 'rtype_na 'rtype_name` last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof ('rtype_name`)); ret->base_addr = xmallocarray (size, sizeof ('rtype_name`)); ret->offset = 0; } @@ -69,7 +69,7 @@ bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, 'rtype_na "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { @@ -117,12 +117,12 @@ bessel_yn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, 'rtype_name` last1, last2, x2rev; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (ret->base_addr == NULL) { size_t size = n2 < n1 ? 0 : n2-n1+1; - GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, size, sizeof ('rtype_name`)); ret->base_addr = xmallocarray (size, sizeof ('rtype_name`)); ret->offset = 0; } @@ -136,7 +136,7 @@ bessel_yn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, "(%ld vs. %ld)", (long int) n2-n1, (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (unlikely (x == 0)) { diff --git a/libgfortran/m4/cshift0.m4 b/libgfortran/m4/cshift0.m4 index b836656e44c..841419401b5 100644 --- a/libgfortran/m4/cshift0.m4 +++ b/libgfortran/m4/cshift0.m4 @@ -70,10 +70,10 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + roffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); if (roffset == 0) roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + soffset = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); if (soffset == 0) soffset = 1; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -82,8 +82,8 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); n++; } } diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4 index b1c88263c53..4c601ab65fa 100644 --- a/libgfortran/m4/cshift1.m4 +++ b/libgfortran/m4/cshift1.m4 @@ -73,30 +73,27 @@ cshift1 (gfc_array_char * const restrict ret, if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) runtime_error ("Argument ''`DIM''` is out of range in call to ''`CSHIFT''`"); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); arraysize = size0 ((array_t *)array); if (ret->base_addr == NULL) { int i; + index_type sm, ext; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; + sm = sizeof ('atype_name`); + ext = 1; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + sm *= ext; + ext = GFC_DESCRIPTOR_EXTENT (array, i); - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; - - if (i == 0) - str = 1; - else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * - GFC_DESCRIPTOR_STRIDE(ret,i-1); - - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } } else if (unlikely (compile_options.bounds_check)) @@ -127,10 +124,10 @@ cshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -139,10 +136,10 @@ cshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4 index f68a56dc1eb..c6737ea2aa8 100644 --- a/libgfortran/m4/eoshift1.m4 +++ b/libgfortran/m4/eoshift1.m4 @@ -74,7 +74,7 @@ eoshift1 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -89,21 +89,22 @@ eoshift1 (gfc_array_char * const restrict ret, { int i; + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array, i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -130,10 +131,10 @@ eoshift1 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -142,10 +143,10 @@ eoshift1 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); n++; } } diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4 index f99842ae936..fab8622c6cb 100644 --- a/libgfortran/m4/eoshift3.m4 +++ b/libgfortran/m4/eoshift3.m4 @@ -79,7 +79,7 @@ eoshift3 (gfc_array_char * const restrict ret, roffset = 0; arraysize = size0 ((array_t *) array); - size = GFC_DESCRIPTOR_SIZE(array); + size = GFC_DESCRIPTOR_ELEM_LEN(array); if (pwhich) which = *pwhich - 1; @@ -91,21 +91,22 @@ eoshift3 (gfc_array_char * const restrict ret, int i; ret->base_addr = xmallocarray (arraysize, size); + ret->elem_len = array->elem_len; + ret->type = array->type; ret->offset = 0; - ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) { - index_type ub, str; + index_type ext, sm; - ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + ext = GFC_DESCRIPTOR_EXTENT (array,i); if (i == 0) - str = 1; + sm = size; else - str = GFC_DESCRIPTOR_EXTENT(ret,i-1) - * GFC_DESCRIPTOR_STRIDE(ret,i-1); + sm = GFC_DESCRIPTOR_EXTENT (ret, i-1) + * GFC_DESCRIPTOR_SM (ret, i-1); - GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + GFC_DIMENSION_SET (ret->dim[i], 0, ext, sm); } /* xmallocarray allocates a single byte for zero size. */ @@ -134,10 +135,10 @@ eoshift3 (gfc_array_char * const restrict ret, { if (dim == which) { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + roffset = GFC_DESCRIPTOR_SM(ret,dim); if (roffset == 0) roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + soffset = GFC_DESCRIPTOR_SM(array,dim); if (soffset == 0) soffset = size; len = GFC_DESCRIPTOR_EXTENT(array,dim); @@ -146,12 +147,12 @@ eoshift3 (gfc_array_char * const restrict ret, { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + rstride[n] = GFC_DESCRIPTOR_SM(ret,dim); + sstride[n] = GFC_DESCRIPTOR_SM(array,dim); - hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + hstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(h,n); if (bound) - bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + bstride[n] = GFC_DESCRIPTOR_SM(bound,n); else bstride[n] = 0; n++; diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index 2b916af66dd..41bddafd797 100644 --- a/libgfortran/m4/iforeach.m4 +++ b/libgfortran/m4/iforeach.m4 @@ -27,8 +27,9 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (rtype_name)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (rtype_name)); } @@ -39,11 +40,11 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, "u_name"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -130,8 +131,9 @@ void if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (rtype_name)); + retarray->elem_len = retarray->elem_len; + retarray->type = retarray->type; retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (rtype_name)); } @@ -147,7 +149,7 @@ void } } - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); mbase = mask->base_addr; @@ -160,12 +162,12 @@ void else runtime_error ("Funny sized logical array"); - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) @@ -261,8 +263,7 @@ void if (retarray->base_addr == NULL) { - GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + GFC_DIMENSION_SET (retarray->dim[0], 0, rank, sizeof (rtype_name)); retarray->offset = 0; retarray->base_addr = xmallocarray (rank, sizeof (rtype_name)); } @@ -272,7 +273,7 @@ void "u_name"); } - dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); dest = retarray->base_addr; for (n = 0; n<rank; n++) dest[n * dstride] = $1 ; diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4 index b4de9a87608..53d091b0f46 100644 --- a/libgfortran/m4/ifunction.m4 +++ b/libgfortran/m4/ifunction.m4 @@ -48,11 +48,11 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE(array,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -60,7 +60,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -69,23 +69,24 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (rtype_name); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name)); if (alloc_size == 0) @@ -112,7 +113,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -210,7 +211,7 @@ void mbase = mask->base_addr; - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -221,13 +222,13 @@ void else runtime_error ("Funny sized logical array"); - delta = GFC_DESCRIPTOR_STRIDE(array,dim); - mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + delta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,dim); + mdelta = GFC_DESCRIPTOR_SM(mask,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -236,8 +237,8 @@ void } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_SM(mask, n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) @@ -246,23 +247,24 @@ void if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm ; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (rtype_name); else - str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + sm = GFC_DESCRIPTOR_SM (retarray, n-1) * extent[n-1]; - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + retarray->elem_len = array->elem_len; + retarray->type = array->type; if (alloc_size == 0) { @@ -291,7 +293,7 @@ void for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } @@ -399,23 +401,23 @@ void if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (rtype_name); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -453,7 +455,7 @@ void for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); } dest = retarray->base_addr; diff --git a/libgfortran/m4/ifunction_logical.m4 b/libgfortran/m4/ifunction_logical.m4 index fd3afb074f8..e8509bbc86c 100644 --- a/libgfortran/m4/ifunction_logical.m4 +++ b/libgfortran/m4/ifunction_logical.m4 @@ -46,17 +46,17 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - src_kind = GFC_DESCRIPTOR_SIZE (array); + src_kind = GFC_DESCRIPTOR_ELEM_LEN (array); len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len < 0) len = 0; - delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + delta = GFC_DESCRIPTOR_SM(array,dim); for (n = 0; n < dim; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] < 0) @@ -64,7 +64,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + sstride[n] = GFC_DESCRIPTOR_SM(array,n + 1); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); if (extent[n] < 0) @@ -73,23 +73,23 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, if (retarray->base_addr == NULL) { - size_t alloc_size, str; + size_t alloc_size, sm; for (n = 0; n < rank; n++) { if (n == 0) - str = 1; + sm = sizeof (rtype_name); else - str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; - - GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + sm = GFC_DESCRIPTOR_SM (retarray,n-1) * extent[n-1]; + GFC_DIMENSION_SET (retarray->dim[n], 0, extent[n], sm); } + retarray->elem_len = array->elem_len; + retarray->type = array->type; retarray->offset = 0; - retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; - alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; + alloc_size = GFC_DESCRIPTOR_SM (retarray, rank-1) * extent[rank-1]; if (alloc_size == 0) { @@ -127,7 +127,7 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + dstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,n); if (extent[n] <= 0) return; } diff --git a/libgfortran/m4/in_pack.m4 b/libgfortran/m4/in_pack.m4 index 7b5dea694ae..382d20e5a32 100644 --- a/libgfortran/m4/in_pack.m4 +++ b/libgfortran/m4/in_pack.m4 @@ -60,7 +60,7 @@ internal_pack_'rtype_ccode` ('rtype` * source) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { diff --git a/libgfortran/m4/in_unpack.m4 b/libgfortran/m4/in_unpack.m4 index 865d04b6728..342625c70b1 100644 --- a/libgfortran/m4/in_unpack.m4 +++ b/libgfortran/m4/in_unpack.m4 @@ -55,7 +55,7 @@ internal_unpack_'rtype_ccode` ('rtype` * d, const 'rtype_name` * src) for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + stride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; diff --git a/libgfortran/m4/matmul.m4 b/libgfortran/m4/matmul.m4 index 468615b6c42..a0176d37bc1 100644 --- a/libgfortran/m4/matmul.m4 +++ b/libgfortran/m4/matmul.m4 @@ -107,21 +107,22 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, if (GFC_DESCRIPTOR_RANK (a) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DESCRIPTOR_EXTENT(b,1), sizeof ('rtype_name`)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof ('rtype_name`)); } else { GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DESCRIPTOR_EXTENT(a,0), sizeof ('rtype_name`)); GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof ('rtype_name`)); } retarray->base_addr @@ -177,19 +178,19 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl /* One-dimensional result may be addressed in the code below either as a row or a column matrix. We want both cases to work. */ - rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } if (GFC_DESCRIPTOR_RANK (a) == 1) { /* Treat it as a a row matrix A[1,count]. */ - axstride = GFC_DESCRIPTOR_STRIDE(a,0); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); aystride = 1; xcount = 1; @@ -197,8 +198,8 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } else { - axstride = GFC_DESCRIPTOR_STRIDE(a,0); - aystride = GFC_DESCRIPTOR_STRIDE(a,1); + axstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,0); + aystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); xcount = GFC_DESCRIPTOR_EXTENT(a,0); @@ -213,7 +214,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl if (GFC_DESCRIPTOR_RANK (b) == 1) { /* Treat it as a column matrix B[count,1] */ - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); /* bystride should never be used for 1-dimensional b. in case it is we want it to cause a segfault, rather than @@ -223,8 +224,8 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } else { - bxstride = GFC_DESCRIPTOR_STRIDE(b,0); - bystride = GFC_DESCRIPTOR_STRIDE(b,1); + bxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,0); + bystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4 index b4c9bec4441..b23e6b0c29a 100644 --- a/libgfortran/m4/matmull.m4 +++ b/libgfortran/m4/matmull.m4 @@ -70,22 +70,23 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, { if (GFC_DESCRIPTOR_RANK (a) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1), sizeof ('rtype_name`)); } else if (GFC_DESCRIPTOR_RANK (b) == 1) { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof ('rtype_name`)); } else { - GFC_DIMENSION_SET(retarray->dim[0], 0, - GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + GFC_DIMENSION_SET (retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0), sizeof ('rtype_name`)); - GFC_DIMENSION_SET(retarray->dim[1], 0, - GFC_DESCRIPTOR_EXTENT(b,1) - 1, - GFC_DESCRIPTOR_EXTENT(retarray,0)); + GFC_DIMENSION_SET (retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1), + GFC_DESCRIPTOR_EXTENT(retarray,0) + * sizeof ('rtype_name`)); } retarray->base_addr @@ -135,7 +136,7 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, } abase = a->base_addr; - a_kind = GFC_DESCRIPTOR_SIZE (a); + a_kind = GFC_DESCRIPTOR_ELEM_LEN (a); if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -147,7 +148,7 @@ matmul_'rtype_code` ('rtype` * const restrict retarray, internal_error (NULL, "Funny sized logical array"); bbase = b->base_addr; - b_kind = GFC_DESCRIPTOR_SIZE (b); + b_kind = GFC_DESCRIPTOR_ELEM_LEN (b); if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -164,20 +165,20 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ` if (GFC_DESCRIPTOR_RANK (retarray) == 1) { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); rystride = rxstride; } else { - rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); - rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(retarray,1); } /* If we have rank 1 parameters, zero the absent stride, and set the size to one. */ if (GFC_DESCRIPTOR_RANK (a) == 1) { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + astride = GFC_DESCRIPTOR_SM(a,0); count = GFC_DESCRIPTOR_EXTENT(a,0); xstride = 0; rxstride = 0; @@ -185,14 +186,14 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } else { - astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + astride = GFC_DESCRIPTOR_SM(a,1); count = GFC_DESCRIPTOR_EXTENT(a,1); - xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xstride = GFC_DESCRIPTOR_SM(a,0); xcount = GFC_DESCRIPTOR_EXTENT(a,0); } if (GFC_DESCRIPTOR_RANK (b) == 1) { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); ystride = 0; rystride = 0; @@ -200,9 +201,9 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl } else { - bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + bstride = GFC_DESCRIPTOR_SM(b,0); assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); - ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ystride = GFC_DESCRIPTOR_SM(b,1); ycount = GFC_DESCRIPTOR_EXTENT(b,1); } diff --git a/libgfortran/m4/pack.m4 b/libgfortran/m4/pack.m4 index 28fc2a66224..9562aff9269 100644 --- a/libgfortran/m4/pack.m4 +++ b/libgfortran/m4/pack.m4 @@ -104,7 +104,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -126,8 +126,8 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); if (extent[n] <= 0) zero_sized = 1; - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(array,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (sstride[0] == 0) sstride[0] = 1; @@ -164,7 +164,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, if (ret->base_addr == NULL) { /* Setup the array descriptor. */ - GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, total, sizeof ('rtype_name`)); ret->offset = 0; @@ -187,7 +187,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, } } - rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + rstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (rstride0 == 0) rstride0 = 1; sstride0 = sstride[0]; @@ -240,7 +240,7 @@ pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, nelem = ((rptr - ret->base_addr) / rstride0); if (n > nelem) { - sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + sstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (sstride0 == 0) sstride0 = 1; diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index 460360150b1..4c4a87445ff 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -31,7 +31,7 @@ include(iparm.m4)dnl `#if defined (HAVE_'rtype_name`) -typedef GFC_ARRAY_DESCRIPTOR(1, 'index_type`) 'shape_type`;' +typedef CFI_CDESC_TYPE_T(1, 'index_type`) 'shape_type`;' dnl For integer routines, only the kind (ie size) is used to name the dnl function. The same function will be used for integer and logical @@ -91,7 +91,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < rdim; n++) { - shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(shape,0)]; if (shape_data[n] <= 0) { shape_data[n] = 0; @@ -103,12 +103,12 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, { index_type alloc_size; - rs = 1; + rs = sizeof ('rtype_name`); for (n = 0; n < rdim; n++) { rex = shape_data[n]; - GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + GFC_DIMENSION_SET(ret->dim[n], 0, rex, rs); rs *= rex; } @@ -120,7 +120,8 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, alloc_size = rs; ret->base_addr = xmallocarray (alloc_size, sizeof ('rtype_name`)); - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + ret->elem_len = source->elem_len; + ret->type = source->type; } if (shape_empty) @@ -134,7 +135,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < pdim; n++) { pcount[n] = 0; - pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(pad,n); pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); if (pextent[n] <= 0) { @@ -197,7 +198,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < rdim; n++) { - v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; if (v < 0 || v >= rdim) runtime_error("Value %ld out of range in ORDER argument" @@ -216,12 +217,12 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < rdim; n++) { if (order) - dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(order,0)] - 1; else dim = n; rcount[n] = 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,dim); rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); if (rextent[n] < 0) rextent[n] = 0; @@ -243,7 +244,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, for (n = 0; n < sdim; n++) { scount[n] = 0; - sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,n); sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (sextent[n] <= 0) { diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4 index 9704c6b6730..c67c68a1537 100644 --- a/libgfortran/m4/shape.m4 +++ b/libgfortran/m4/shape.m4 @@ -48,12 +48,12 @@ shape_'rtype_kind` ('rtype` * const restrict ret, if (ret->base_addr == NULL) { - GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, rank, sizeof ('rtype_name`)); ret->offset = 0; ret->base_addr = xmallocarray (rank, sizeof ('rtype_name`)); } - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) return; diff --git a/libgfortran/m4/spread.m4 b/libgfortran/m4/spread.m4 index da03cc6da64..0dd88eaedf1 100644 --- a/libgfortran/m4/spread.m4 +++ b/libgfortran/m4/spread.m4 @@ -71,11 +71,12 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, if (ret->base_addr == NULL) { - size_t ub, stride; + size_t ext, stride; /* The front end has signalled that we need to populate the return array descriptor. */ - ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + ret->elem_len = source->elem_len; + ret->type = source->type; dim = 0; rs = 1; for (n = 0; n < rrank; n++) @@ -83,7 +84,7 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, stride = rs; if (n == along - 1) { - ub = ncopies - 1; + ext = ncopies; rdelta = rs; rs *= ncopies; } @@ -91,14 +92,14 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, { count[dim] = 0; extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); rstride[dim] = rs; - ub = extent[dim] - 1; + ext = extent[dim]; rs *= extent[dim]; dim++; } - GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + GFC_DIMENSION_SET(ret->dim[n], 0, ext, stride * sizeof('rtype_name`)); } ret->offset = 0; @@ -126,7 +127,7 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); if (ret_extent != ncopies) runtime_error("Incorrect extent in return value of SPREAD" @@ -147,8 +148,8 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -159,7 +160,7 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, { if (n == along - 1) { - rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + rdelta = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); } else { @@ -167,8 +168,8 @@ spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); if (extent[dim] <= 0) zero_sized = 1; - sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); - rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); dim++; } } @@ -247,17 +248,17 @@ spread_scalar_'rtype_code` ('rtype` *ret, const 'rtype_name` *source, { ret->base_addr = xmallocarray (ncopies, sizeof ('rtype_name`)); ret->offset = 0; - GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies, sizeof ('rtype_name`)); } else { if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) - / GFC_DESCRIPTOR_STRIDE(ret,0)) + / GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0)) runtime_error ("dim too large in spread()"); } dest = ret->base_addr; - stride = GFC_DESCRIPTOR_STRIDE(ret,0); + stride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); for (n = 0; n < ncopies; n++) { diff --git a/libgfortran/m4/transpose.m4 b/libgfortran/m4/transpose.m4 index 04a7ca482c1..d70cd5e71db 100644 --- a/libgfortran/m4/transpose.m4 +++ b/libgfortran/m4/transpose.m4 @@ -53,13 +53,13 @@ transpose_'rtype_code` ('rtype` * const restrict ret, if (ret->base_addr == NULL) { assert (GFC_DESCRIPTOR_RANK (ret) == 2); - assert (ret->dtype == source->dtype); + assert (ret->type == source->type); - GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, - 1); + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1), + sizeof ('rtype_name`)); - GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, - GFC_DESCRIPTOR_EXTENT(source, 1)); + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0), + GFC_DESCRIPTOR_EXTENT(source, 1)*sizeof ('rtype_name`)); ret->base_addr = xmallocarray (size0 ((array_t *) ret), sizeof ('rtype_name`)); @@ -88,13 +88,13 @@ transpose_'rtype_code` ('rtype` * const restrict ret, } - sxstride = GFC_DESCRIPTOR_STRIDE(source,0); - systride = GFC_DESCRIPTOR_STRIDE(source,1); + sxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,0); + systride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(source,1); xcount = GFC_DESCRIPTOR_EXTENT(source,0); ycount = GFC_DESCRIPTOR_EXTENT(source,1); - rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); - rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + rxstride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,1); rptr = ret->base_addr; sptr = source->base_addr; diff --git a/libgfortran/m4/unpack.m4 b/libgfortran/m4/unpack.m4 index 883827665bd..0f6792e45c1 100644 --- a/libgfortran/m4/unpack.m4 +++ b/libgfortran/m4/unpack.m4 @@ -67,7 +67,7 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -92,11 +92,12 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof ('rtype_name`)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -112,8 +113,8 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -125,7 +126,7 @@ unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; @@ -213,7 +214,7 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, /* Use the same loop for all logical types, by using GFC_LOGICAL_1 and using shifting to address size and endian issues. */ - mask_kind = GFC_DESCRIPTOR_SIZE (mask); + mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask); if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 #ifdef HAVE_GFC_LOGICAL_16 @@ -238,12 +239,13 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, { count[n] = 0; GFC_DIMENSION_SET(ret->dim[n], 0, - GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + GFC_DESCRIPTOR_EXTENT(mask,n), + rs * sizeof ('rtype_name`)); extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); rs *= extent[n]; } ret->offset = 0; @@ -259,9 +261,9 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); empty = empty || extent[n] <= 0; - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); - fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); - mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(field,n); + mstride[n] = GFC_DESCRIPTOR_SM(mask,n); } if (rstride[0] == 0) rstride[0] = 1; @@ -275,7 +277,7 @@ unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, if (mstride[0] == 0) mstride[0] = 1; - vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + vstride0 = GFC_DESCRIPTOR_STRIDE_TYPEKNOWN(vector,0); if (vstride0 == 0) vstride0 = 1; rstride0 = rstride[0]; diff --git a/libgfortran/mk-kinds-ts29113.sh b/libgfortran/mk-kinds-ts29113.sh new file mode 100644 index 00000000000..3b7a96e638c --- /dev/null +++ b/libgfortran/mk-kinds-ts29113.sh @@ -0,0 +1,170 @@ +#!/bin/sh +LC_ALL=C +export LC_ALL + +compile="$1" + +# Obtain the available kinds: + +echo "use iso_fortran_env; print *, integer_kinds; print *, real_kinds ; end" > tmq$$.f90 +$compile -S -fdump-tree-original tmq$$.f90 +INTEGER_KINDS=`grep ' integer_kinds' tmq$$.f90.*original* | sed -e 's/.*{//' -e 's/,//g' -e 's/}.*//'` +REAL_KINDS=`grep ' real_kinds' tmq$$.f90.*original* | sed -e 's/.*{//' -e 's/,//g' -e 's/}.*//'` +rm -f tmq$$.* + +# Obtain the ISO-C-Binding kinds +echo "" +echo "/* TS 29113 types. */" +echo "" + +# Integers +cat <<EOF > tmq$$.f90 +subroutine kinds() +use iso_c_binding +integer :: i_c_signed_char, i_c_short, i_c_int, i_c_long, i_c_long_long +integer :: i_c_size_t, i_c_int8_t, i_c_int16_t, i_c_int32_t, i_c_int64_t +integer :: i_c_int_least8_t, i_c_int_least16_t, i_c_int_least32_t +integer :: i_c_int_least64_t, i_c_int_fast8_t, i_c_int_fast16_t +integer :: i_c_int_fast32_t, i_c_int_fast64_t, i_c_intmax_t +integer :: i_c_intptr_t, i_c_ptrdiff_t + +i_c_signed_char = c_signed_char +i_c_short = c_short +i_c_int = c_int +i_c_long = c_long +i_c_long_long = c_long_long +i_c_size_t = c_size_t +i_c_int8_t = c_int8_t +i_c_int16_t = c_int16_t +i_c_int32_t = c_int32_t +i_c_int64_t = c_int64_t +i_c_int_least8_t = c_int_least8_t +i_c_int_least16_t = c_int_least16_t +i_c_int_least32_t = c_int_least32_t +i_c_int_least64_t = c_int_least64_t +i_c_int_fast8_t = c_int_fast8_t +i_c_int_fast16_t = c_int_fast16_t +i_c_int_fast32_t = c_int_fast32_t +i_c_int_fast64_t = c_int_fast64_t +i_c_intmax_t = c_intmax_t +i_c_intptr_t = c_intptr_t +i_c_ptrdiff_t = c_ptrdiff_t +EOF + +if echo $INTEGER_KINDS |grep -q 16; then +cat <<EOF >> tmq$$.f90 +block +integer :: i_c_int128_t, i_c_int_least128_t, i_c_int_fast128_t +i_c_int128_t = c_int128_t +i_c_int_least128_t = c_int_least128_t +i_c_int_fast128_t = c_int_fast128_t +end block +EOF +fi +echo "end" >> tmq$$.f90 + +$compile -S -fdump-tree-original tmq$$.f90 +grep ' = ' tmq$$.f90.*original* \ + | sed -e 's/ *i_c_/#define CFI_type_/' -e 's/ = / (CFI_type_Integer + (/' \ + -e 's/;/ << CFI_type_kind_shift))/' +rm -f tmq$$.* + +# Logical/Bool +cat <<EOF > tmq$$.f90 +subroutine kinds() +use iso_c_binding +integer :: i_c_bool +i_c_bool = c_bool +end +EOF + +$compile -S -fdump-tree-original tmq$$.f90 +grep ' = ' tmq$$.f90.*original* \ + | sed -e 's/bool/Bool/' -e 's/ *i_c_/#define CFI_type_/' \ + -e 's/ = / (CFI_type_Logical + (/' \ + -e 's/;/ << CFI_type_kind_shift))/' +rm -f tmq$$.* + +# Real +cat <<EOF > tmq$$.f90 +subroutine kinds() +use iso_c_binding +integer :: i_c_float, i_c_double, i_c_long_double + +i_c_float = c_float +i_c_double = c_double +i_c_long_double = c_long_double +EOF + +if echo $REAL_KINDS |grep -q 16; then +cat <<EOF >> tmq$$.f90 +block +integer :: i_C_FLOAT128 +i_C_FLOAT128 = C_FLOAT128 +end block +EOF +fi + +echo "end" >> tmq$$.f90 +$compile -S -fdump-tree-original tmq$$.f90 +grep ' = ' tmq$$.f90.*original* \ + | sed -e 's/ *i_c_/#define CFI_type_/' -e 's/ = / (CFI_type_Real + (/' \ + -e 's/;/ << CFI_type_kind_shift))/' +rm -f tmq$$.* + +# Complex +cat <<EOF > tmq$$.f90 +subroutine kinds() +use iso_c_binding +integer :: i_c_float_complex, i_c_double_complex, i_c_long_double_complex + +i_c_float_complex = c_float_complex +i_c_double_complex = c_double_complex +i_c_long_double_complex = c_long_double_complex +EOF + +if echo $REAL_KINDS |grep -q 16; then +cat <<EOF >> tmq$$.f90 +block +integer :: i_C_FLOAT128_COMPLEX +i_C_FLOAT128_COMPLEX = C_FLOAT128_COMPLEX +end block +EOF +fi + +echo "end" >> tmq$$.f90 +$compile -S -fdump-tree-original tmq$$.f90 +grep ' = ' tmq$$.f90.*original* \ + | sed -e 's/complex/Complex/' \ + -e 's/ *i_c_/#define CFI_type_/' -e 's/ = / (CFI_type_Complex + (/' \ + -e 's/;/ << CFI_type_kind_shift))/' +rm -f tmq$$.* + + +echo "" +echo "/* gfortran intrinsic non-character types. */" +echo "" +for I in $INTEGER_KINDS; do + echo "#define CFI_type_Integer$I (CFI_type_Integer + ($I << CFI_type_kind_shift))" +done + +for I in $INTEGER_KINDS; do + echo "#define CFI_type_Logical$I (CFI_type_Logical + ($I << CFI_type_kind_shift))" +done + +for I in $REAL_KINDS; do + echo "#define CFI_type_Real$I (CFI_type_Real + ($I << CFI_type_kind_shift))" +done + +for I in $REAL_KINDS; do + echo "#define CFI_type_Complex$I (CFI_type_Complex + ($I << CFI_type_kind_shift))" +done + +cat <<EOF + +#ifdef __cplusplus +} +#endif + +#endif /* ISO_FORTRAN_BINDING_H */ +EOF diff --git a/libgfortran/runtime/bounds.c b/libgfortran/runtime/bounds.c index f130ba03206..34d58f32750 100644 --- a/libgfortran/runtime/bounds.c +++ b/libgfortran/runtime/bounds.c @@ -214,7 +214,7 @@ index_type count_0 (const gfc_array_l1 * array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - kind = GFC_DESCRIPTOR_SIZE (array); + kind = GFC_DESCRIPTOR_ELEM_LEN (array); base = array->base_addr; @@ -232,7 +232,7 @@ index_type count_0 (const gfc_array_l1 * array) for (n = 0; n < rank; n++) { - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + sstride[n] = GFC_DESCRIPTOR_SM(array,n); extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; diff --git a/libgfortran/runtime/in_pack_generic.c b/libgfortran/runtime/in_pack_generic.c index 3ab9a0c337a..f89afa2d8e4 100644 --- a/libgfortran/runtime/in_pack_generic.c +++ b/libgfortran/runtime/in_pack_generic.c @@ -36,132 +36,125 @@ internal_pack (gfc_array_char * source) { index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; - index_type stride0; + index_type sm[GFC_MAX_DIMENSIONS]; index_type dim; index_type ssize; + index_type sm0; const char *src; char *dest; void *destptr; int n; int packed; index_type size; - index_type type_size; + CFI_type_t type; if (source->base_addr == NULL) - return NULL; + return source->base_addr; + + type = GFC_DESCRIPTOR_TYPE (source); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (source) == 1) + type = CFI_type_Integer1; - type_size = GFC_DTYPE_TYPE_SIZE(source); - size = GFC_DESCRIPTOR_SIZE (source); - switch (type_size) + switch (type) { - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_DERIVED_1: + case CFI_type_Integer1: + case CFI_type_Logical1: return internal_pack_1 ((gfc_array_i1 *) source); - case GFC_DTYPE_INTEGER_2: - case GFC_DTYPE_LOGICAL_2: + case CFI_type_Integer2: + case CFI_type_Logical2: return internal_pack_2 ((gfc_array_i2 *) source); - case GFC_DTYPE_INTEGER_4: - case GFC_DTYPE_LOGICAL_4: + case CFI_type_Integer4: + case CFI_type_Logical4: return internal_pack_4 ((gfc_array_i4 *) source); - case GFC_DTYPE_INTEGER_8: - case GFC_DTYPE_LOGICAL_8: + case CFI_type_Integer8: + case CFI_type_Logical8: return internal_pack_8 ((gfc_array_i8 *) source); #if defined(HAVE_GFC_INTEGER_16) - case GFC_DTYPE_INTEGER_16: - case GFC_DTYPE_LOGICAL_16: + case CFI_type_Integer16: + case CFI_type_Logical16: return internal_pack_16 ((gfc_array_i16 *) source); #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: return internal_pack_r4 ((gfc_array_r4 *) source); - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: return internal_pack_r8 ((gfc_array_r8 *) source); -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # if defined (HAVE_GFC_REAL_10) - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: return internal_pack_r10 ((gfc_array_r10 *) source); # endif # if defined (HAVE_GFC_REAL_16) - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: return internal_pack_r16 ((gfc_array_r16 *) source); # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: return internal_pack_c4 ((gfc_array_c4 *) source); - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: return internal_pack_c8 ((gfc_array_c8 *) source); -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # if defined (HAVE_GFC_COMPLEX_10) - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: return internal_pack_c10 ((gfc_array_c10 *) source); # endif # if defined (HAVE_GFC_COMPLEX_16) - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: return internal_pack_c16 ((gfc_array_c16 *) source); # endif -#endif - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(source->base_addr)) - break; - else - return internal_pack_2 ((gfc_array_i2 *) source); - - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(source->base_addr)) - break; - else - return internal_pack_4 ((gfc_array_i4 *) source); - - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(source->base_addr)) - break; - else - return internal_pack_8 ((gfc_array_i8 *) source); + case CFI_type_struct: + case CFI_type_other: + switch (GFC_DESCRIPTOR_ELEM_LEN(source)) + { + case 2: + if (GFC_UNALIGNED_2(source->base_addr)) + break; + else + return internal_pack_2 ((gfc_array_i2 *) source); + + case 4: + if (GFC_UNALIGNED_4(source->base_addr)) + break; + else + return internal_pack_4 ((gfc_array_i4 *) source); + + case 8: + if (GFC_UNALIGNED_8(source->base_addr)) + break; + else + return internal_pack_8 ((gfc_array_i8 *) source); #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(source->base_addr)) - break; - else - return internal_pack_16 ((gfc_array_i16 *) source); + case 16: + if (GFC_UNALIGNED_16(source->base_addr)) + break; + else + return internal_pack_16 ((gfc_array_i16 *) source); #endif + } + break; default: break; } dim = GFC_DESCRIPTOR_RANK (source); - ssize = 1; + size = GFC_DESCRIPTOR_ELEM_LEN (source); + ssize = size; packed = 1; for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sm[n] = GFC_DESCRIPTOR_SM(source,n); extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); if (extent[n] <= 0) { @@ -170,7 +163,7 @@ internal_pack (gfc_array_char * source) break; } - if (ssize != stride[n]) + if (ssize != sm[n]) packed = 0; ssize *= extent[n]; @@ -179,11 +172,11 @@ internal_pack (gfc_array_char * source) if (packed) return source->base_addr; - /* Allocate storage for the destination. */ - destptr = xmallocarray (ssize, size); + /* Allocate storage for the destination. */ + destptr = xmalloc (ssize); dest = (char *)destptr; src = source->base_addr; - stride0 = stride[0] * size; + sm0 = sm[0]; while (src) { @@ -191,7 +184,7 @@ internal_pack (gfc_array_char * source) memcpy(dest, src, size); /* Advance to the next element. */ dest += size; - src += stride0; + src += sm0; count[0]++; /* Advance to the next source element. */ n = 0; @@ -202,7 +195,7 @@ internal_pack (gfc_array_char * source) count[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - src -= stride[n] * extent[n] * size; + src -= sm[n] * extent[n]; n++; if (n == dim) { @@ -212,7 +205,7 @@ internal_pack (gfc_array_char * source) else { count[n]++; - src += stride[n] * size; + src += sm[n]; } } } diff --git a/libgfortran/runtime/in_unpack_generic.c b/libgfortran/runtime/in_unpack_generic.c index a29edf2df68..2718f11c32a 100644 --- a/libgfortran/runtime/in_unpack_generic.c +++ b/libgfortran/runtime/in_unpack_generic.c @@ -36,162 +36,156 @@ internal_unpack (gfc_array_char * d, const void * s) { index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; - index_type stride0; + index_type sm[GFC_MAX_DIMENSIONS]; + index_type sm0; index_type dim; index_type dsize; char *dest; const char *src; int n; int size; - int type_size; + CFI_type_t type; dest = d->base_addr; /* This check may be redundant, but do it anyway. */ if (s == dest || !s) return; - type_size = GFC_DTYPE_TYPE_SIZE (d); - switch (type_size) + type = GFC_DESCRIPTOR_TYPE (d); + if ((type == CFI_type_struct || type == CFI_type_other) + && GFC_DESCRIPTOR_ELEM_LEN (d) == 1) + type = CFI_type_Integer1; + + switch (type) { - case GFC_DTYPE_INTEGER_1: - case GFC_DTYPE_LOGICAL_1: - case GFC_DTYPE_DERIVED_1: + case CFI_type_Integer1: + case CFI_type_Logical1: internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s); return; - case GFC_DTYPE_INTEGER_2: - case GFC_DTYPE_LOGICAL_2: + case CFI_type_Integer2: + case CFI_type_Logical2: internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); return; - case GFC_DTYPE_INTEGER_4: - case GFC_DTYPE_LOGICAL_4: + case CFI_type_Integer4: + case CFI_type_Logical4: internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); return; - case GFC_DTYPE_INTEGER_8: - case GFC_DTYPE_LOGICAL_8: + case CFI_type_Integer8: + case CFI_type_Logical8: internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); return; #if defined (HAVE_GFC_INTEGER_16) - case GFC_DTYPE_INTEGER_16: - case GFC_DTYPE_LOGICAL_16: + case CFI_type_Integer16: + case CFI_type_Logical16: internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); return; #endif - case GFC_DTYPE_REAL_4: + case CFI_type_Real4: internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s); return; - case GFC_DTYPE_REAL_8: + case CFI_type_Real8: internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # if defined(HAVE_GFC_REAL_10) - case GFC_DTYPE_REAL_10: + case CFI_type_Real10: internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s); return; # endif # if defined(HAVE_GFC_REAL_16) - case GFC_DTYPE_REAL_16: + case CFI_type_Real16: internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s); return; # endif -#endif - case GFC_DTYPE_COMPLEX_4: + case CFI_type_Complex4: internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s); return; - case GFC_DTYPE_COMPLEX_8: + case CFI_type_Complex8: internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s); return; -/* FIXME: This here is a hack, which will have to be removed when - the array descriptor is reworked. Currently, we don't store the - kind value for the type, but only the size. Because on targets with - __float128, we have sizeof(logn double) == sizeof(__float128), - we cannot discriminate here and have to fall back to the generic - handling (which is suboptimal). */ -#if !defined(GFC_REAL_16_IS_FLOAT128) # if defined(HAVE_GFC_COMPLEX_10) - case GFC_DTYPE_COMPLEX_10: + case CFI_type_Complex10: internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s); return; # endif # if defined(HAVE_GFC_COMPLEX_16) - case GFC_DTYPE_COMPLEX_16: + case CFI_type_Complex16: internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s); return; # endif -#endif - - case GFC_DTYPE_DERIVED_2: - if (GFC_UNALIGNED_2(d->base_addr) || GFC_UNALIGNED_2(s)) - break; - else - { - internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); - return; - } - case GFC_DTYPE_DERIVED_4: - if (GFC_UNALIGNED_4(d->base_addr) || GFC_UNALIGNED_4(s)) - break; - else - { - internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); - return; - } - case GFC_DTYPE_DERIVED_8: - if (GFC_UNALIGNED_8(d->base_addr) || GFC_UNALIGNED_8(s)) - break; - else + case CFI_type_struct: + case CFI_type_other: + switch (GFC_DESCRIPTOR_ELEM_LEN(d)) { - internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); - return; - } + case 2: + if (GFC_UNALIGNED_2(d->base_addr) || GFC_UNALIGNED_2(s)) + break; + else + { + internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); + return; + } + + case 4: + if (GFC_UNALIGNED_4(d->base_addr) || GFC_UNALIGNED_4(s)) + break; + else + { + internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); + return; + } + + case 8: + if (GFC_UNALIGNED_8(d->base_addr) || GFC_UNALIGNED_8(s)) + break; + else + { + internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); + return; + } #ifdef HAVE_GFC_INTEGER_16 - case GFC_DTYPE_DERIVED_16: - if (GFC_UNALIGNED_16(d->base_addr) || GFC_UNALIGNED_16(s)) - break; - else - { - internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); - return; - } + case 16: + if (GFC_UNALIGNED_16(d->base_addr) || GFC_UNALIGNED_16(s)) + break; + else + { + internal_unpack_16 ((gfc_array_i16 *) d, + (const GFC_INTEGER_16 *) s); + return; + } #endif + } + break; default: break; } - size = GFC_DESCRIPTOR_SIZE (d); - dim = GFC_DESCRIPTOR_RANK (d); - dsize = 1; + size = GFC_DESCRIPTOR_ELEM_LEN (d); + dsize = size; for (n = 0; n < dim; n++) { count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + sm[n] = GFC_DESCRIPTOR_SM(d,n); extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); if (extent[n] <= 0) return; - if (dsize == stride[n]) + if (dsize == sm[n]) dsize *= extent[n]; else dsize = 0; @@ -201,11 +195,11 @@ internal_unpack (gfc_array_char * d, const void * s) if (dsize != 0) { - memcpy (dest, src, dsize * size); + memcpy (dest, src, dsize); return; } - stride0 = stride[0] * size; + sm0 = sm[0]; while (dest) { @@ -213,7 +207,7 @@ internal_unpack (gfc_array_char * d, const void * s) memcpy (dest, src, size); /* Advance to the next element. */ src += size; - dest += stride0; + dest += sm0; count[0]++; /* Advance to the next source element. */ n = 0; @@ -224,7 +218,7 @@ internal_unpack (gfc_array_char * d, const void * s) count[n] = 0; /* We could precalculate these products, but this is a less frequently used path so probably not worth it. */ - dest -= stride[n] * extent[n] * size; + dest -= sm[n] * extent[n]; n++; if (n == dim) { @@ -234,7 +228,7 @@ internal_unpack (gfc_array_char * d, const void * s) else { count[n]++; - dest += stride[n] * size; + dest += sm[n]; } } } diff --git a/libgfortran/runtime/iso_ts29113.c b/libgfortran/runtime/iso_ts29113.c new file mode 100644 index 00000000000..b4470476072 --- /dev/null +++ b/libgfortran/runtime/iso_ts29113.c @@ -0,0 +1,358 @@ +/* iso_ts29113.c. of GCC's GNU Fortran compiler. + Copyright (C) 2013 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran) +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Library General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with libquadmath; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, +Boston, MA 02110-1301, USA. */ + + +/* Functions as defined by ISO/IEC Technical Specification TS 29113:2012 + on Further Interoperability of Fortran with C. */ + +#include <stdlib.h> /* For malloc and free. */ +#include "ISO_Fortran_binding.h" + +#include <stdio.h> + +#ifndef __GNUC__ +# define __attribute__(x) +# define likely(x) (x) +# define unlikely(x) (x) +#else +# define likely(x) __builtin_expect(!!(x), 1) +# define unlikely(x) __builtin_expect(!!(x), 0) +#endif + + +void * +CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[]) +{ + int i; + CFI_index_t offset; + + if (!dv->base_addr || dv->rank == 0) + return dv->base_addr; + + offset = 0; + + /* Notes: For nonalloctables, the lower_bound == 0; the caller ensures that. + No bounds check is done. */ + for (i = 0; i < dv->rank; i++) + offset += (subscripts[i] - dv->dim[i].lower_bound) * dv->dim[i].sm; + + return dv->base_addr + offset; +} + + +/* ALLOCATE. The caller's descriptor already contains dv->base_addr == NULL, + dv->rank, dv->attribute and dv->type; the allocation size is taken from + the dv->elem_len, except for characters; for those it uses elem_len. */ + +int +CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[], + const CFI_index_t upper_bounds[], size_t elem_len) +{ + int i; + size_t size; + intptr_t extent; + + if (unlikely (dv->attribute == CFI_attribute_other)) + return CFI_INVALID_ATTRIBUTE; + + if (unlikely (dv->base_addr)) + return CFI_ERROR_BASE_ADDR_NOT_NULL; + + if (dv->type == CFI_type_char || dv->type == CFI_type_ucs4_char) + dv->elem_len = elem_len; + + size = dv->elem_len; + + for (i = 0; i < dv->rank; i++) + { + dv->dim[i].lower_bound = lower_bounds[i]; + extent = upper_bounds[i] - lower_bounds[i] + 1; + dv->dim[i].extent = unlikely (extent < 0) + ? 0 : extent; + dv->dim[i].sm = size; + size *= dv->dim[i].extent; + } + + if (unlikely (size == 0)) + size = 1; + + dv->base_addr = malloc (size); + + if (unlikely (!dv->base_addr)) + return CFI_ERROR_MEM_ALLOCATION; + + return CFI_SUCCESS; +} + + +int +CFI_deallocate (CFI_cdesc_t *dv) +{ + if (unlikely (dv->attribute == CFI_attribute_other)) + return CFI_INVALID_ATTRIBUTE; + + if (unlikely (!dv->base_addr)) + return CFI_ERROR_BASE_ADDR_NULL; + + /* FIXME: This function shall return an error if a pointer is + not allocated via CFI_allocate/ALLOCATE, i.e. if it is + associated with a named target. RFC: What happens if it is + only the tailing part of a pointer alloc? */ + + free (dv->base_addr); + dv->base_addr = NULL; + return CFI_SUCCESS; +} + + +int +CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute, + CFI_type_t type, size_t elem_len, CFI_rank_t rank, + const CFI_index_t extents[]) +{ + int i; + size_t sm; + + if (unlikely (attribute != CFI_attribute_pointer + && attribute != CFI_attribute_allocatable + && attribute != CFI_attribute_other)) + return CFI_INVALID_ATTRIBUTE; + + if (unlikely (attribute == CFI_attribute_allocatable && base_addr)) + return CFI_ERROR_BASE_ADDR_NOT_NULL; + + if (unlikely (rank > CFI_MAX_RANK)) + return CFI_INVALID_RANK; + + if (rank > 0 && base_addr) + for (i = 0; i < rank; i++) + if (unlikely (extents[i] < 0)) + return CFI_INVALID_EXTENT; + + dv->base_addr = base_addr; + dv->rank = rank; + dv->version = CFI_VERSION; + dv->type = type; + dv->attribute = attribute; + + if (type == CFI_type_char || type == CFI_type_ucs4_char + || type == CFI_type_struct || type == CFI_type_other) + dv->elem_len = elem_len; + else if (type == CFI_type_Real10) + dv->elem_len = 16; + else if (type == CFI_type_Complex10) + dv->elem_len = 32; + else if ((type & CFI_type_mask) == CFI_type_Complex) + dv->elem_len = 2*(type >> CFI_type_kind_shift); + else + dv->elem_len = type >> CFI_type_kind_shift; + + if (!base_addr) + return CFI_SUCCESS; + + sm = dv->elem_len; + for (i = 0; i < rank; i++) + { + dv->dim[i].lower_bound = 0; + dv->dim[i].extent = extents[i]; + dv->dim[i].sm = sm; + sm *= extents[i]; + } + + return CFI_SUCCESS; +} + + +int +CFI_is_contiguous (const CFI_cdesc_t *dv) +{ + int i; + ptrdiff_t size; + + /* Claim that scalars and (invalid!) null pointers are contiguous. */ + if (dv->rank == 0 || !dv->base_addr) + return 1; + + /* Assumed-size array are contiguous. */ + if (dv->dim[dv->rank-1].extent < 0) + return 1; + + size = dv->elem_len; + for (i = 1; i < dv->rank; i++) + { + if (size < dv->dim[i].sm || dv->dim[i].sm < 0) + return 0; + size *= dv->dim[i].sm; + } + + return 1; +} + + +int +CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source, + const CFI_index_t lower_bounds[], + const CFI_index_t upper_bounds[], + const CFI_index_t strides[]) +{ + int i, j; + CFI_index_t offset; + + if (unlikely (result->attribute == CFI_attribute_allocatable)) + return CFI_INVALID_ATTRIBUTE; + + if (unlikely (result->elem_len != source->elem_len)) + return CFI_INVALID_ELEM_LEN; + + if (unlikely (result->type != source->type)) + return CFI_INVALID_TYPE; + + if (strides == NULL && unlikely (result->rank != source->rank)) + return CFI_INVALID_RANK; + + if (strides != NULL) + { + int zero_strides = 0; + + for (i = 0; i < source->rank; i++) + if (strides[i] == 0) + { + CFI_index_t lb = lower_bounds + ? lower_bounds[i] : source->dim[i].lower_bound; + CFI_index_t ub = upper_bounds + ? upper_bounds[i] + : source->dim[i].extent + lb - 1; + if (unlikely ((lb != ub))) + return CFI_INVALID_EXTENT; + zero_strides++; + } + + if (unlikely (result->rank + zero_strides != source->rank)) + return CFI_INVALID_RANK; + } + + offset = 0; + + for (i = 0, j = 0; i < source->rank; i++) + { + if (lower_bounds) + offset += (lower_bounds[i]-source->dim[i].lower_bound)*source->dim[i].sm; + + if (strides && strides[i] == 0) + continue; + + result->dim[j].lower_bound = lower_bounds + ? lower_bounds[i] : source->dim[i].lower_bound; + if (upper_bounds) + { + CFI_index_t extent; + extent = upper_bounds[i] - result->dim[j].lower_bound + 1; + result->dim[j].extent = extent < 0 ? 0 : extent; + } + else + result->dim[j].extent = source->dim[i].extent; + + if (!strides) + result->dim[j].sm = source->dim[i].sm; + else + { + result->dim[j].sm = source->dim[i].sm * strides[i]; + result->dim[j].extent /= strides[i]; + } + + j++; + } + + result->base_addr = source->base_addr + offset; + + return CFI_SUCCESS; +} + + +int +CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source, + size_t displacement, size_t elem_len) +{ + int i; + + if (unlikely (result->attribute == CFI_attribute_allocatable)) + return CFI_INVALID_ATTRIBUTE; + + if (unlikely (!source->base_addr)) + return CFI_ERROR_BASE_ADDR_NULL; + + if (unlikely (result->rank != source->rank)) + return CFI_INVALID_RANK; + + if (unlikely (displacement >= source->elem_len)) + return CFI_INVALID_ELEM_LEN; + + if (result->type == CFI_type_char || result->type == CFI_type_ucs4_char) + { + if (unlikely (elem_len > source->elem_len)) + return CFI_INVALID_ELEM_LEN; + result->elem_len = elem_len; + } + + result->base_addr = source->base_addr + displacement; + + for (i = 1; i < result->rank; i++) + { + result->dim[i].lower_bound = source->dim[i].lower_bound; + result->dim[i].extent = source->dim[i].extent; + result->dim[i].sm = source->dim[i].sm; + } + + return CFI_SUCCESS; +} + + +int +CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source, + const CFI_index_t lower_bounds[]) +{ + int i; + + if (unlikely (result->attribute != CFI_attribute_pointer)) + return CFI_INVALID_ATTRIBUTE; + + if (!source->base_addr) + { + result->base_addr = NULL; + return CFI_SUCCESS; + } + + if (unlikely (result->elem_len != source->elem_len)) + return CFI_INVALID_ELEM_LEN; + + if (unlikely (result->type != source->type)) + return CFI_INVALID_TYPE; + + if (unlikely (result->rank != source->rank)) + return CFI_INVALID_RANK; + + for (i = 0; i < result->rank; i++) + { + result->dim[i].lower_bound = lower_bounds[i]; + result->dim[i].extent = source->dim[i].extent; + result->dim[i].sm = source->dim[i].sm; + } + + return CFI_SUCCESS; +} diff --git a/libstdc++-v3/config/os/qnx/qnx6.1/ctype_noninline.h b/libstdc++-v3/config/os/qnx/qnx6.1/ctype_noninline.h new file mode 100644 index 00000000000..b74e070594e --- /dev/null +++ b/libstdc++-v3/config/os/qnx/qnx6.1/ctype_noninline.h @@ -0,0 +1,89 @@ +// Locale support -*- C++ -*- + +// Copyright (C) 2002, 2009, 2010 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free +// software; you can redistribute it and/or modify it under the +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// Under Section 7 of GPL version 3, you are granted additional +// permissions described in the GCC Runtime Library Exception, version +// 3.1, as published by the Free Software Foundation. + +// You should have received a copy of the GNU General Public License and +// a copy of the GCC Runtime Library Exception along with this program; +// see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +// <http://www.gnu.org/licenses/>. + +/** @file bits/ctype_noninline.h + * This is an internal header file, included by other library headers. + * Do not attempt to use it directly. @headername{locale} + */ + +// +// ISO C++ 14882: 22.1 Locales +// + +// Information as gleaned from /usr/include/ctype.h + + const ctype_base::mask* + ctype<char>::classic_table() throw() + { return 0; } + + ctype<char>::ctype(__c_locale, const mask* __table, bool __del, + size_t __refs) + : facet(__refs), _M_del(__table != 0 && __del), + _M_toupper(NULL), _M_tolower(NULL), _M_table(__table ? __table : _Ctype) + { + memset(_M_widen, 0, sizeof(_M_widen)); + _M_widen_ok = 0; + memset(_M_narrow, 0, sizeof(_M_narrow)); + _M_narrow_ok = 0; + } + + ctype<char>::ctype(const mask* __table, bool __del, size_t __refs) + : facet(__refs), _M_del(__table != 0 && __del), + _M_toupper(NULL), _M_tolower(NULL), _M_table(__table ? __table : _Ctype) + { + memset(_M_widen, 0, sizeof(_M_widen)); + _M_widen_ok = 0; + memset(_M_narrow, 0, sizeof(_M_narrow)); + _M_narrow_ok = 0; + } + + char + ctype<char>::do_toupper(char __c) const + { return ::toupper((int) __c); } + + const char* + ctype<char>::do_toupper(char* __low, const char* __high) const + { + while (__low < __high) + { + *__low = ::toupper((int) *__low); + ++__low; + } + return __high; + } + + char + ctype<char>::do_tolower(char __c) const + { return ::tolower((int) __c); } + + const char* + ctype<char>::do_tolower(char* __low, const char* __high) const + { + while (__low < __high) + { + *__low = ::tolower((int) *__low); + ++__low; + } + return __high; + } |