+2009-06-21 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/37577
+ Port from fortran-dev
+ * runtime/in_pack_generic (internal_pack): Remove unnecessary
+ test for stride == 0.
+ * runtime/in_unpack_generic.c (internal_unpack): Likewise.
+ * intrinsics/iso_c_binding.c (c_f_pointer_u0): Take care
+ of stride in "shape" argument. Use array access macros for
+ accessing array descriptors.
+ * libgfortran.h (struct descriptor_dimension): Change stride
+ to _stride, lbound to _lbound and ubound to _ubound.
+ (GFC_DIMENSION_LBOUND): Use new name(s) in struct
+ descriptor_dimension.
+ (GFC_DIMENSION_UBOUND): Likewise.
+ (GFC_DIMENSION_STRIDE): Likewise.
+ (GFC_DIMENSION_EXTENT): Likewise.
+ (GFC_DIMENSION_SET): Likewise.
+ (GFC_DESCRIPTOR_LBOUND): Likewise.
+ (GFC_DESCRIPTOR_UBOUND): Likewise.
+ (GFC_DESCRIPTOR_EXTENT): Likewise.
+ (GFC_DESCRIPTOR_STRIDE): Likewise.
+ * io/transfer.c (transfer_array): Use array access macros.
+ Use byte-sized strides.
+ * intrinsics/eoshift0.c (eoshift0): Use array access
+ macros everywhere.
+ * m4/in_pack.m4 (internal_pack_'rtype_ccode`): Use
+ array access macros for accessing array descriptors.
+ * m4/in_unpack.m4 (internal_unpack_'rtype_ccode`):
+ Likewise.
+ * m4/matmull.m4 (matmul_'rtype_code`): Likewise.
+ * m4/matmul.m4 (matmul_'rtype_code`): Likewise.
+ * m4/unpack.m4 (unpack0_'rtype_code`): Likewise.
+ (unpack1_'rtype_code`): Likewise.
+ * m4/ifunction_logical.m4 (name`'rtype_qual`_'atype_code): Likewise.
+ * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Use array access
+ macros everywhere.
+ * intrinsics/dtime.c (dtime_sub): Use array access macros
+ for accessing array descriptors.
+ * intrinsics/cshift0 (cshift0): Likewise.
+ * intrinsics/etime.c: Likewise. Remove redundant calculation
+ of rdim.
+ * m4/cshift0.m4 (cshift0_'rtype_code`): Use array access macros
+ for accessing array descriptors.
+ * m4/pack.m4 (pack_'rtype_code`): Likewise.
+ * m4/spread.m4 (spread_'rtype_code`): Likewise.
+ (spread_scalar_'rtype_code`): Likewise.
+ * m4/transpose.m4 (transpose_'rtype_code`): Likewise.
+ * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise.
+ * m4/eoshift1.m4 (eoshift1): Likewise. Remove size argument,
+ calculate within function.
+ (eoshift1_'atype_kind`): Remove size argument from call
+ to eoshift1.
+ (eoshift1_'atype_kind`_char): Likewise.
+ (eoshift1_'atype_kind`_char4): Likewise.
+ * m4/eoshift3.m4 (eoshift3): Remove size argument, calculate
+ within function. Use array access macros for accessing array
+ descriptors.
+ (eoshift3_'atype_kind`): Remove size argument from call
+ to eoshift1.
+ (eoshift3_'atype_kind`_char): Likewise.
+ (eoshift3_'atype_kind`_char4): Likewise.
+ * m4/shape.m4 (shape_'rtype_kind`): Use array access macros
+ for accessing array descriptors.
+ * m4/cshift1.m4 (cshift1): Remove size argument, calculate
+ within function. Use array access macros for accessing array
+ descriptors.
+ (cshift1_'atype_kind`): Remove size argument from call to
+ cshift1.
+ (cshift1_'atype_kind`_char): Remove size argument from call to
+ cshift1.
+ (cshift1_'atype_kind`_char4): Remove size argument from call to
+ cshift1.
+ * m4/reshape.m4 (reshape_'rtype_ccode`): Use array access macros
+ for accessing array descriptors.
+ * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Likewise.
+ * intrinsics/pack_generic.c (pack_internal): Use array access
+ macros for accessing array descriptors.
+ (pack_s_internal): Likewise.
+ * intrinsics/transpose_generic.c (transpose_internal): Remove
+ size argument, calculate from array descriptor. Use array
+ access macros for accessing array descriptors.
+ (transpose): Remove size argument from call.
+ (transpoe_char): Likewise.
+ (transpose_char4): Likewise.
+ * intrinsics/move_alloc.c (move_alloc): Use array access macros
+ for accessing array descriptors.
+ * intrinsics/spread_generic.c (spread_internal): Remove size
+ argument, calculate from array descriptor. Use array access
+ macros for accessing array descriptors.
+ (spread_internal_scalar): Likewise.
+ (spread): Remove size argument from call to spread_internal.
+ (spread_char): Mark argument source_length as unused.
+ Remove size argument from call to spread_internal.
+ (spread_char4): Likewise.
+ (spread_char_scalar): Likewise.
+ (spread_char4_scalar): Likewise.
+ * intrinsics/unpack_generic.c (unpack_internal): Use array access
+ macros for accessing array descriptors.
+ * intrinsics/eoshift2.c (eoshift2): Remove size argument, calculate
+ from array descriptor instead. Use array access macros for
+ accessing array descriptors.
+ (eoshift2_##N): Remove size argument from call to eoshift2.
+ (eoshift2_##N_##char): Likewise.
+ (eoshift2_##N_##char4): Likewise.
+ * intrinsics/reshape_generic.c (reshape_internal): Use array
+ access macross for accessing array descriptors.
+ * libgfortran.h: Introduce new macros GFC_DIMENSION_LBOUND,
+ GFC_DIMENSION_UBOUND,GFC_DIMENSION_STRIDE, GFC_DIMENSION_EXTENT,
+ GFC_DIMENSION_SET, GFC_DESCRIPTOR_LBOUND, GFC_DESCRIPTOR_UBOUND,
+ GFC_DESCRIPTOR_EXTENT, GFC_DESCRIPTOR_EXTENT_BYTES,
+ GFC_DESCRIPTOR_STRIDE, GFC_DESCRIPTOR_STRIDE_BYTES
+ * runtime/in_pack_generic.c (internal_pack): Use new macros
+ for array descriptor access.
+ * runtime/in_unpack_generic.c (internal_unpack): Likewise.
+ * intrinsics/dtime.c (dtime_sub): Likewise.
+ * intrinsics/cshift0 (cshift0): Remove argument size,
+ calculate directly from the array descriptor. Use new macros
+ for array descriptor access.
+ * cshift0_##N: Remove shift argument in call to cshift0.
+ * cshift0_##N_char: Mark array_length as unused. Remove
+ array_length in call to cshift0.
+ * cshift0_##N_char4: Likewise.
+ * intrisics/etime.c: Use new macros for array descriptor access.
+ * intrinsics/stat.c (stat_i4_sub_0): Likewise.
+ (stat_i8_sub_0): Likewise.
+ (fstat_i4_sub): Likewise.
+ (fstat_i8_sub): Likewise.
+ * intrinsics/date_and_time.c (date_and_time): Likewise.
+ (secnds): Likewise.
+ (itime_i4): Likewise.
+ (itime_i8): Likewise.
+ (idate_i4): Likewise.
+ (idate_i8): Likewise.
+ (gmtime_i4): Likewise.
+ (gmtime_i8): Likewise.
+ (ltime_i4): Likewise.
+ (litme_i8): Likewise.
+ * intrinsics/associated.c (associated): Likewise.
+ * intrinsics/eoshift0.c (eoshift0): Likewise.
+ * intriniscs/size.c (size0): Likewise.
+ * intrinsics/random.c (arandom_r4): Likewise.
+ (arandom_r8): Likewise.
+ (arandom_r10): Likewise.
+ (arandom_r16): Likewise.
+ (random_seed_i4): Likewise.
+ (random_seed_i8): Likewise.
+ * io/list_read.c (nml_parse_qualifier): Likewise.
+ (nml_touch_nodes): Likewise.
+ (nml_read_obj): Likewise.
+ (get_name): Likewise.
+ * io/transfer.c (transfer_array): Likewise.
+ (init_loop_spec): Likewise.
+ (st_set_nml_var_dim): Likewise.
+ * io/write.c (nml_write_obj): Likewise.
+ (obj_loop): Likewise.
+ * 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/cshift0_c10.c: Regenerated.
+ * generated/cshift0_c16.c: Regenerated.
+ * generated/cshift0_c4.c: Regenerated.
+ * generated/cshift0_c8.c: Regenerated.
+ * generated/cshift0_i1.c: Regenerated.
+ * generated/cshift0_i16.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/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_i1.c: Regenerated.
+ * generated/in_pack_i16.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_i1.c: Regenerated.
+ * generated/in_unpack_i16.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/matmul_c10.c: Regenerated.
+ * generated/matmul_c16.c: Regenerated.
+ * generated/matmul_c4.c: Regenerated.
+ * generated/matmul_c8.c: Regenerated.
+ * generated/matmul_i1.c: Regenerated.
+ * generated/matmul_i16.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_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/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/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/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_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.
+
2009-06-14 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* fmain.c (main): Don't PREFIX set_args.
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_LOGICAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_LOGICAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
cshift1 (gfc_array_char * const restrict ret,
const gfc_array_char * const restrict array,
const gfc_array_i16 * const restrict h,
- const GFC_INTEGER_16 * const restrict pwhich,
- index_type size)
+ const GFC_INTEGER_16 * const restrict pwhich)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
int which;
GFC_INTEGER_16 sh;
index_type arraysize;
+ index_type size;
if (pwhich)
which = *pwhich - 1;
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);
+
arraysize = size0 ((array_t *)array);
if (ret->data == NULL)
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
+ GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const gfc_array_i16 * const restrict h,
const GFC_INTEGER_16 * const restrict pwhich)
{
- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const gfc_array_i16 * const restrict h,
const GFC_INTEGER_16 * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length);
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const gfc_array_i16 * const restrict h,
const GFC_INTEGER_16 * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+ cshift1 (ret, array, h, pwhich);
}
#endif
cshift1 (gfc_array_char * const restrict ret,
const gfc_array_char * const restrict array,
const gfc_array_i4 * const restrict h,
- const GFC_INTEGER_4 * const restrict pwhich,
- index_type size)
+ const GFC_INTEGER_4 * const restrict pwhich)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
int which;
GFC_INTEGER_4 sh;
index_type arraysize;
+ index_type size;
if (pwhich)
which = *pwhich - 1;
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);
+
arraysize = size0 ((array_t *)array);
if (ret->data == NULL)
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
+ GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const gfc_array_i4 * const restrict h,
const GFC_INTEGER_4 * const restrict pwhich)
{
- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const gfc_array_i4 * const restrict h,
const GFC_INTEGER_4 * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length);
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const gfc_array_i4 * const restrict h,
const GFC_INTEGER_4 * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+ cshift1 (ret, array, h, pwhich);
}
#endif
cshift1 (gfc_array_char * const restrict ret,
const gfc_array_char * const restrict array,
const gfc_array_i8 * const restrict h,
- const GFC_INTEGER_8 * const restrict pwhich,
- index_type size)
+ const GFC_INTEGER_8 * const restrict pwhich)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
int which;
GFC_INTEGER_8 sh;
index_type arraysize;
+ index_type size;
if (pwhich)
which = *pwhich - 1;
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);
+
arraysize = size0 ((array_t *)array);
if (ret->data == NULL)
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
+ GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const gfc_array_i8 * const restrict h,
const GFC_INTEGER_8 * const restrict pwhich)
{
- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const gfc_array_i8 * const restrict h,
const GFC_INTEGER_8 * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length);
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const gfc_array_i8 * const restrict h,
const GFC_INTEGER_8 * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+ cshift1 (ret, array, h, pwhich);
}
#endif
const gfc_array_i16 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_16 * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const char * const restrict pbound,
const GFC_INTEGER_16 * const restrict pwhich)
{
- eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, "\0", 1);
}
const gfc_array_i16 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_16 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, " ", 1);
}
const gfc_array_i16 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_16 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ' ';
- eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift1 (ret, array, h, pbound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
const gfc_array_i4 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_4 * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const char * const restrict pbound,
const GFC_INTEGER_4 * const restrict pwhich)
{
- eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, "\0", 1);
}
const gfc_array_i4 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_4 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, " ", 1);
}
const gfc_array_i4 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_4 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ' ';
- eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift1 (ret, array, h, pbound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
const gfc_array_i8 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_8 * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const char * const restrict pbound,
const GFC_INTEGER_8 * const restrict pwhich)
{
- eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, "\0", 1);
}
const gfc_array_i8 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_8 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, " ", 1);
}
const gfc_array_i8 * const restrict h,
const char * const restrict pbound,
const GFC_INTEGER_8 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ' ';
- eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift1 (ret, array, h, pbound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
const gfc_array_i16 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_16 * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
if (bound)
- bstride[n] = bound->dim[n].stride * size;
+ bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
else
bstride[n] = 0;
n++;
const gfc_array_char * const restrict bound,
const GFC_INTEGER_16 * const restrict pwhich)
{
- eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
}
const gfc_array_i16 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_16 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+ eoshift3 (ret, array, h, bound, pwhich, " ", 1);
}
const gfc_array_i16 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_16 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ' ';
- eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift3 (ret, array, h, bound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
const gfc_array_i4 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_4 * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
if (bound)
- bstride[n] = bound->dim[n].stride * size;
+ bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
else
bstride[n] = 0;
n++;
const gfc_array_char * const restrict bound,
const GFC_INTEGER_4 * const restrict pwhich)
{
- eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
}
const gfc_array_i4 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_4 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+ eoshift3 (ret, array, h, bound, pwhich, " ", 1);
}
const gfc_array_i4 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_4 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ' ';
- eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift3 (ret, array, h, bound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
const gfc_array_i8 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_8 * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
if (bound)
- bstride[n] = bound->dim[n].stride * size;
+ bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
else
bstride[n] = 0;
n++;
const gfc_array_char * const restrict bound,
const GFC_INTEGER_8 * const restrict pwhich)
{
- eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
}
const gfc_array_i8 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_8 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+ eoshift3 (ret, array, h, bound, pwhich, " ", 1);
}
const gfc_array_i8 * const restrict h,
const gfc_array_char * const restrict bound,
const GFC_INTEGER_8 * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ' ';
- eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift3 (ret, array, h, bound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
-
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
+
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
{
- rxstride = retarray->dim[0].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
rystride = rxstride;
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(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 = a->dim[0].stride * a_kind;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
xstride = 0;
rxstride = 0;
xcount = 1;
}
else
{
- astride = a->dim[1].stride * a_kind;
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xstride = a->dim[0].stride * a_kind;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1);
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
ystride = 0;
rystride = 0;
ycount = 1;
}
else
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
- ystride = b->dim[1].stride * b_kind;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
+ ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
for (y = 0; y < ycount; y++)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
-
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
+
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
{
- rxstride = retarray->dim[0].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
rystride = rxstride;
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(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 = a->dim[0].stride * a_kind;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
xstride = 0;
rxstride = 0;
xcount = 1;
}
else
{
- astride = a->dim[1].stride * a_kind;
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xstride = a->dim[0].stride * a_kind;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1);
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
ystride = 0;
rystride = 0;
ycount = 1;
}
else
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
- ystride = b->dim[1].stride * b_kind;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
+ ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
for (y = 0; y < ycount; y++)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
-
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
+
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
{
- rxstride = retarray->dim[0].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
rystride = rxstride;
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(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 = a->dim[0].stride * a_kind;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
xstride = 0;
rxstride = 0;
xcount = 1;
}
else
{
- astride = a->dim[1].stride * a_kind;
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xstride = a->dim[0].stride * a_kind;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1);
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
ystride = 0;
rystride = 0;
ycount = 1;
}
else
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
- ystride = b->dim[1].stride * b_kind;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
+ ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
for (y = 0; y < ycount; y++)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINVAL intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" PRODUCT intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
-/* Implementation of the RESHAPE
+/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
index_type stride;
index_type extent;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
- if (ret->dim[0].ubound < ret->dim[0].lbound)
+ if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
{
- extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;
}
}
index_type stride;
index_type extent;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
- if (ret->dim[0].ubound < ret->dim[0].lbound)
+ if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
{
- extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;
}
}
index_type stride;
index_type extent;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
- if (ret->dim[0].ubound < ret->dim[0].lbound)
+ if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
{
- extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;
}
}
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_10));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_16));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_4));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_8));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_1));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_16));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_2));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_4));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_8));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_10));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_16));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_4));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_8));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_COMPLEX_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_10) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_16) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_4) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" SUM intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
rank = GFC_DESCRIPTOR_RANK (pointer);
for (n = 0; n < rank; n++)
{
- long diff;
- diff = pointer->dim[n].ubound - pointer->dim[n].lbound;
+ long extent;
+ extent = GFC_DESCRIPTOR_EXTENT(pointer,n);
- if (diff != (target->dim[n].ubound - target->dim[n].lbound))
+ if (extent != GFC_DESCRIPTOR_EXTENT(target,n))
return 0;
- if (pointer->dim[n].stride != target->dim[n].stride && diff != 0)
+ if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1)
return 0;
- if (pointer->dim[n].ubound < pointer->dim[n].lbound)
+ if (extent <= 0)
return 0;
}
/* Generic implementation of the CSHIFT intrinsic
- Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
+ Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc.
Contributed by Feng Wang <wf_cs@yahoo.com>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran 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 of the License, or (at your option) any later version.
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
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 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/>. */
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
static void
cshift0 (gfc_array_char * ret, const gfc_array_char * array,
- index_type shift, int which, index_type size)
+ ssize_t shift, int which, index_type size)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1)
- * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
+ GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
n++;
}
}
rptr = ret->data;
sptr = array->data;
- shift = len == 0 ? 0 : shift % len;
+ shift = len == 0 ? 0 : shift % (ssize_t)len;
if (shift < 0)
shift += len;
index_type len, delta, elt_size;
elt_size = GFC_DESCRIPTOR_SIZE (__values);
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
- delta = __values->dim[0].stride;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
& GFC_DTYPE_TYPE_MASK) +
(4 << GFC_DTYPE_SIZE_SHIFT);
- avalues->dim[0].ubound = 7;
- avalues->dim[0].lbound = 0;
- avalues->dim[0].stride = 1;
+ GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1);
date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0);
itime0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
itime0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
idate0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
idate0(x);
/* Copy the value into the array. */
- len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(__values,0);
assert (len >= 3);
- delta = __values->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
gmtime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
gmtime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
ltime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
ltime_0(&tt, x);
/* Copy the values into the array. */
- len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(tarray,0);
assert (len >= 9);
- delta = tarray->dim[0].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(tarray,0);
if (delta == 0)
delta = 1;
GFC_REAL_4 *tp;
long user_sec, user_usec, system_sec, system_usec;
- if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
+ if (((GFC_DESCRIPTOR_EXTENT(t,0))) < 2)
runtime_error ("Insufficient number of elements in TARRAY.");
__gthread_mutex_lock (&dtime_update_lock);
tp = t->data;
*tp = tu;
- tp += t->dim[0].stride;
+ tp += GFC_DESCRIPTOR_STRIDE(t,0);
*tp = ts;
*result = tt;
__gthread_mutex_unlock (&dtime_update_lock);
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
n++;
}
}
static void
eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
int shift, const gfc_array_char *bound, int which,
- index_type size, const char *filler, index_type filler_len)
+ const char *filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type len;
index_type n;
index_type arraysize;
+ index_type size;
/* The compiler cannot figure out that these are set, initialize
them to avoid warnings. */
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE (array);
+
arraysize = size0 ((array_t *) array);
if (ret->data == NULL)
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (bound)
- bstride[n] = bound->dim[n].stride * size;
+ bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
else
bstride[n] = 0;
n++;
const GFC_INTEGER_##N *pdim) \
{ \
eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \
- GFC_DESCRIPTOR_SIZE (array), "\0", 1); \
+ "\0", 1); \
} \
\
extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \
const GFC_INTEGER_##N *pshift, \
const gfc_array_char *pbound, \
const GFC_INTEGER_##N *pdim, \
- GFC_INTEGER_4 array_length, \
+ GFC_INTEGER_4 array_length __attribute__((unused)), \
GFC_INTEGER_4 bound_length __attribute__((unused))) \
{ \
eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \
- array_length, " ", 1); \
+ " ", 1); \
} \
\
extern void eoshift2_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \
const GFC_INTEGER_##N *pshift, \
const gfc_array_char *pbound, \
const GFC_INTEGER_##N *pdim, \
- GFC_INTEGER_4 array_length, \
+ GFC_INTEGER_4 array_length __attribute__((unused)), \
GFC_INTEGER_4 bound_length __attribute__((unused))) \
{ \
static const gfc_char4_t space = (unsigned char) ' '; \
eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \
- array_length * sizeof (gfc_char4_t), (const char *) &space, \
+ (const char *) &space, \
sizeof (gfc_char4_t)); \
}
GFC_REAL_4 tu, ts, tt, *tp;
long user_sec, user_usec, system_sec, system_usec;
- if (((t->dim[0].ubound + 1 - t->dim[0].lbound)) < 2)
+ if (((GFC_DESCRIPTOR_EXTENT(t,0))) < 2)
runtime_error ("Insufficient number of elements in TARRAY.");
if (__time_1 (&user_sec, &user_usec, &system_sec, &system_usec) == 0)
tp = t->data;
*tp = tu;
- tp += t->dim[0].stride;
+ tp += GFC_DESCRIPTOR_STRIDE(t,0);
*tp = ts;
*result = tt;
}
/* A generic function to set the common fields of all descriptors, no
- matter whether it's to a scalar or an array. Fields set are: data,
- and if appropriate, rank, offset, dim[*].lbound, dim[*].ubound, and
- dim[*].stride. Parameter shape is a rank 1 array of integers
+ matter whether it's to a scalar or an array. Access is via the array
+ descrptor macros. Parameter shape is a rank 1 array of integers
containing the upper bound of each dimension of what f_ptr_out
points to. The length of this array must be EXACTLY the rank of
what f_ptr_out points to, as required by the draft (J3/04-007). If
p = shape->data;
size = GFC_DESCRIPTOR_SIZE(shape);
- source_stride = shape->dim[0].stride * size;
+ source_stride = GFC_DESCRIPTOR_STRIDE_BYTES(shape,0);
/* shape's length (rank of the output array) */
- shapeSize = shape->dim[0].ubound + 1 - shape->dim[0].lbound;
+ shapeSize = GFC_DESCRIPTOR_EXTENT(shape,0);
for (i = 0; i < shapeSize; i++)
{
- /* Lower bound is 1, as specified by the draft. */
- f_ptr_out->dim[i].lbound = 1;
+ index_type str, ub;
+
/* Have to allow for the SHAPE array to be any valid kind for
an INTEGER type. */
#ifdef HAVE_GFC_INTEGER_1
if (size == 1)
- f_ptr_out->dim[i].ubound = *((GFC_INTEGER_1 *) p);
+ ub = *((GFC_INTEGER_1 *) p);
#endif
#ifdef HAVE_GFC_INTEGER_2
if (size == 2)
- f_ptr_out->dim[i].ubound = *((GFC_INTEGER_2 *) p);
+ ub = *((GFC_INTEGER_2 *) p);
#endif
#ifdef HAVE_GFC_INTEGER_4
if (size == 4)
- f_ptr_out->dim[i].ubound = *((GFC_INTEGER_4 *) p);
+ ub = *((GFC_INTEGER_4 *) p);
#endif
#ifdef HAVE_GFC_INTEGER_8
if (size == 8)
- f_ptr_out->dim[i].ubound = *((GFC_INTEGER_8 *) p);
+ ub = *((GFC_INTEGER_8 *) p);
#endif
#ifdef HAVE_GFC_INTEGER_16
if (size == 16)
- f_ptr_out->dim[i].ubound = *((GFC_INTEGER_16 *) p);
+ ub = *((GFC_INTEGER_16 *) p);
#endif
p += source_stride;
if (i == 0)
{
- f_ptr_out->dim[0].stride = 1;
- f_ptr_out->offset = f_ptr_out->dim[0].lbound
- * f_ptr_out->dim[0].stride;
+ str = 1;
+ f_ptr_out->offset = str;
}
else
{
- f_ptr_out->dim[i].stride = (f_ptr_out->dim[i-1].ubound + 1)
- - f_ptr_out->dim[i-1].lbound;
- f_ptr_out->offset += f_ptr_out->dim[i].lbound
- * f_ptr_out->dim[i].stride;
+ str = GFC_DESCRIPTOR_EXTENT(f_ptr_out,i-1);
+ f_ptr_out->offset += str;
}
+
+ /* Lower bound is 1, as specified by the draft. */
+ GFC_DIMENSION_SET(f_ptr_out->dim[i], 1, ub, str);
}
f_ptr_out->offset *= -1;
for (i = 0; i < GFC_DESCRIPTOR_RANK (from); i++)
{
- to->dim[i].lbound = from->dim[i].lbound;
- to->dim[i].ubound = from->dim[i].ubound;
- to->dim[i].stride = from->dim[i].stride;
- from->dim[i].stride = 0;
- from->dim[i].ubound = from->dim[i].lbound;
+ 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);
}
to->offset = from->offset;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride * size;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = size;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
}
else
{
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride * size;
+ rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
if (rstride0 == 0)
rstride0 = size;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride * size;
+ sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
if (sstride0 == 0)
sstride0 = size;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
- sstride[n] = array->dim[n].stride * size;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
ssize *= extent[n];
}
if (sstride[0] == 0)
{
/* The return array will have as many elements as there are
in vector. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total <= 0)
{
total = 0;
}
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0],0,total-1,1);
+
ret->offset = 0;
if (total == 0)
ret->data = internal_malloc_size (size * total);
}
- rstride0 = ret->dim[0].stride * size;
+ rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
if (rstride0 == 0)
rstride0 = size;
rptr = ret->data;
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride * size;
+ sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
if (sstride0 == 0)
sstride0 = size;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = x->dim[n].stride;
- extent[n] = x->dim[n].ubound + 1 - x->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
if (extent[n] <= 0)
return;
}
runtime_error ("Array rank of PUT is not 1.");
/* If the array is too small, abort. */
- if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size)
+ if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size)
runtime_error ("Array size of PUT is too small.");
/* We copy the seed given by the user. */
for (i = 0; i < kiss_size; i++)
memcpy (seed + i * sizeof(GFC_UINTEGER_4),
- &(put->data[(kiss_size - 1 - i) * put->dim[0].stride]),
+ &(put->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(put,0)]),
sizeof(GFC_UINTEGER_4));
/* We put it after scrambling the bytes, to paper around users who
runtime_error ("Array rank of GET is not 1.");
/* If the array is too small, abort. */
- if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size)
+ if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size)
runtime_error ("Array size of GET is too small.");
/* Unscramble the seed. */
/* Then copy it back to the user variable. */
for (i = 0; i < kiss_size; i++)
- memcpy (&(get->data[(kiss_size - 1 - i) * get->dim[0].stride]),
+ memcpy (&(get->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(get,0)]),
seed + i * sizeof(GFC_UINTEGER_4),
sizeof(GFC_UINTEGER_4));
}
runtime_error ("Array rank of PUT is not 1.");
/* If the array is too small, abort. */
- if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size / 2)
+ if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size / 2)
runtime_error ("Array size of PUT is too small.");
/* This code now should do correct strides. */
for (i = 0; i < kiss_size / 2; i++)
- memcpy (&kiss_seed[2*i], &(put->data[i * put->dim[0].stride]),
+ memcpy (&kiss_seed[2*i], &(put->data[i * GFC_DESCRIPTOR_STRIDE(put,0)]),
sizeof (GFC_UINTEGER_8));
}
runtime_error ("Array rank of GET is not 1.");
/* If the array is too small, abort. */
- if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size / 2)
+ if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size / 2)
runtime_error ("Array size of GET is too small.");
/* This code now should do correct strides. */
for (i = 0; i < kiss_size / 2; i++)
- memcpy (&(get->data[i * get->dim[0].stride]), &kiss_seed[2*i],
+ memcpy (&(get->data[i * GFC_DESCRIPTOR_STRIDE(get,0)]), &kiss_seed[2*i],
sizeof (GFC_UINTEGER_8));
}
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
if (ret->data == NULL)
{
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n],0,rex - 1,rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] != shape_data[dim])
runtime_error ("shape and target do not conform");
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
size = 1;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
{
- len = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,n);
if (len < 0)
len = 0;
size *= len;
dim--;
- size = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ size = GFC_DESCRIPTOR_EXTENT(array,dim);
if (size < 0)
size = 0;
return size;
static void
spread_internal (gfc_array_char *ret, const gfc_array_char *source,
- const index_type *along, const index_type *pncopies,
- index_type size)
+ const index_type *along, const index_type *pncopies)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type n;
index_type dim;
index_type ncopies;
+ index_type size;
+
+ size = GFC_DESCRIPTOR_SIZE(source);
srank = GFC_DESCRIPTOR_RANK(source);
{
/* The front end has signalled that we need to populate the
return array descriptor. */
+
+ size_t ub, stride;
+
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
dim = 0;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == *along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs * size;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride * size;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
rstride[dim] = rs * size;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim]-1;
rs *= extent[dim];
dim++;
}
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == *along - 1)
{
- rdelta = ret->dim[n].stride * size;
+ rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride * size;
- rstride[dim] = ret->dim[n].stride * size;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
dim++;
}
}
{
if (n == *along - 1)
{
- rdelta = ret->dim[n].stride * size;
+ rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride * size;
- rstride[dim] = ret->dim[n].stride * size;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);
dim++;
}
}
static void
spread_internal_scalar (gfc_array_char *ret, const char *source,
- const index_type *along, const index_type *pncopies,
- index_type size)
+ const index_type *along, const index_type *pncopies)
{
int n;
int ncopies = *pncopies;
char * dest;
+ size_t size;
+
+ size = GFC_DESCRIPTOR_SIZE(ret);
if (GFC_DESCRIPTOR_RANK (ret) != 1)
runtime_error ("incorrect destination rank in spread()");
{
ret->data = internal_malloc_size (ncopies * size);
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (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->data + n*size*ret->dim[0].stride);
+ dest = (char*)(ret->data + n * GFC_DESCRIPTOR_STRIDE_BYTES(ret,0));
memcpy (dest , source, size);
}
}
#endif
}
- spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source));
+ spread_internal (ret, source, along, pncopies);
}
spread_char (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const gfc_array_char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- spread_internal (ret, source, along, pncopies, source_length);
+ spread_internal (ret, source, along, pncopies);
}
spread_char4 (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const gfc_array_char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- spread_internal (ret, source, along, pncopies,
- source_length * sizeof (gfc_char4_t));
+ spread_internal (ret, source, along, pncopies);
}
#endif
}
- spread_internal_scalar (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (ret));
+ spread_internal_scalar (ret, source, along, pncopies);
}
spread_char_scalar (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
if (!ret->dtype)
runtime_error ("return array missing descriptor in spread()");
- spread_internal_scalar (ret, source, along, pncopies, source_length);
+ spread_internal_scalar (ret, source, along, pncopies);
}
spread_char4_scalar (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
const char *source, const index_type *along,
- const index_type *pncopies, GFC_INTEGER_4 source_length)
+ const index_type *pncopies,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
if (!ret->dtype)
runtime_error ("return array missing descriptor in spread()");
- spread_internal_scalar (ret, source, along, pncopies,
- source_length * sizeof (gfc_char4_t));
+ spread_internal_scalar (ret, source, along, pncopies);
+
}
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Trim trailing spaces from name. */
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
- sarray->data[0 * sarray->dim[0].stride] = sb.st_dev;
+ sarray->data[0 * stride] = sb.st_dev;
/* Inode number */
- sarray->data[1 * sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[1 * stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Trim trailing spaces from name. */
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
sarray->data[0] = sb.st_dev;
/* Inode number */
- sarray->data[sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Convert Fortran unit number to C file descriptor. */
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
- sarray->data[0 * sarray->dim[0].stride] = sb.st_dev;
+ sarray->data[0 * stride] = sb.st_dev;
/* Inode number */
- sarray->data[1 * sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[1 * stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
runtime_error ("Array rank of SARRAY is not 1.");
/* If the array is too small, abort. */
- if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13)
+ if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
/* Convert Fortran unit number to C file descriptor. */
if (val == 0)
{
+ index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
+
/* Device ID */
sarray->data[0] = sb.st_dev;
/* Inode number */
- sarray->data[sarray->dim[0].stride] = sb.st_ino;
+ sarray->data[stride] = sb.st_ino;
/* File mode */
- sarray->data[2 * sarray->dim[0].stride] = sb.st_mode;
+ sarray->data[2 * stride] = sb.st_mode;
/* Number of (hard) links */
- sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink;
+ sarray->data[3 * stride] = sb.st_nlink;
/* Owner's uid */
- sarray->data[4 * sarray->dim[0].stride] = sb.st_uid;
+ sarray->data[4 * stride] = sb.st_uid;
/* Owner's gid */
- sarray->data[5 * sarray->dim[0].stride] = sb.st_gid;
+ sarray->data[5 * stride] = sb.st_gid;
/* ID of device containing directory entry for file (0 if not available) */
#if HAVE_STRUCT_STAT_ST_RDEV
- sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev;
+ sarray->data[6 * stride] = sb.st_rdev;
#else
- sarray->data[6 * sarray->dim[0].stride] = 0;
+ sarray->data[6 * stride] = 0;
#endif
/* File size (bytes) */
- sarray->data[7 * sarray->dim[0].stride] = sb.st_size;
+ sarray->data[7 * stride] = sb.st_size;
/* Last access time */
- sarray->data[8 * sarray->dim[0].stride] = sb.st_atime;
+ sarray->data[8 * stride] = sb.st_atime;
/* Last modification time */
- sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime;
+ sarray->data[9 * stride] = sb.st_mtime;
/* Last file status change time */
- sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime;
+ sarray->data[10 * stride] = sb.st_ctime;
/* Preferred I/O block size (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLKSIZE
- sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize;
+ sarray->data[11 * stride] = sb.st_blksize;
#else
- sarray->data[11 * sarray->dim[0].stride] = -1;
+ sarray->data[11 * stride] = -1;
#endif
/* Number of blocks allocated (-1 if not available) */
#if HAVE_STRUCT_STAT_ST_BLOCKS
- sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks;
+ sarray->data[12 * stride] = sb.st_blocks;
#else
- sarray->data[12 * sarray->dim[0].stride] = -1;
+ sarray->data[12 * stride] = -1;
#endif
}
export_proto(transpose);
static void
-transpose_internal (gfc_array_char *ret, gfc_array_char *source,
- index_type size)
+transpose_internal (gfc_array_char *ret, gfc_array_char *source)
{
/* r.* indicates the return array. */
index_type rxstride, rystride;
index_type xcount, ycount;
index_type x, y;
+ index_type size;
assert (GFC_DESCRIPTOR_RANK (source) == 2
&& GFC_DESCRIPTOR_RANK (ret) == 2);
+ size = GFC_DESCRIPTOR_SIZE(ret);
+
if (ret->data == NULL)
{
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (size * size0 ((array_t*)ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride * size;
- systride = source->dim[1].stride * size;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE_BYTES(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE_BYTES(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride * size;
- rystride = ret->dim[1].stride * size;
+ rxstride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,1);
rptr = ret->data;
sptr = source->data;
void
transpose (gfc_array_char *ret, gfc_array_char *source)
{
- transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source));
+ transpose_internal (ret, source);
}
void
transpose_char (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
- gfc_array_char *source, GFC_INTEGER_4 source_length)
+ gfc_array_char *source,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- transpose_internal (ret, source, source_length);
+ transpose_internal (ret, source);
}
void
transpose_char4 (gfc_array_char *ret,
GFC_INTEGER_4 ret_length __attribute__((unused)),
- gfc_array_char *source, GFC_INTEGER_4 source_length)
+ gfc_array_char *source,
+ GFC_INTEGER_4 source_length __attribute__((unused)))
{
- transpose_internal (ret, source, source_length * sizeof (gfc_char4_t));
+ transpose_internal (ret, source);
}
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride * size;
- fstride[n] = field->dim[n].stride * fsize;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride * size;
- fstride[n] = field->dim[n].stride * fsize;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
}
if (rstride[0] == 0)
rstride[0] = size;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride * size;
+ vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
if (vstride0 == 0)
vstride0 = size;
rstride0 = rstride[0];
}
/* Check the values of the triplet indices. */
- if ((ls[dim].start > (ssize_t)ad[dim].ubound)
- || (ls[dim].start < (ssize_t)ad[dim].lbound)
- || (ls[dim].end > (ssize_t)ad[dim].ubound)
- || (ls[dim].end < (ssize_t)ad[dim].lbound))
+ if ((ls[dim].start > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim]))
+ || (ls[dim].start < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim]))
+ || (ls[dim].end > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim]))
+ || (ls[dim].end < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim])))
{
if (is_char)
sprintf (parse_err_msg, "Substring out of range");
for (dim=0; dim < nl->var_rank; dim++)
{
nl->ls[dim].step = 1;
- nl->ls[dim].end = nl->dim[dim].ubound;
- nl->ls[dim].start = nl->dim[dim].lbound;
+ nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim);
+ nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim);
nl->ls[dim].idx = nl->ls[dim].start;
}
}
pdata = (void*)(nl->mem_pos + offset);
for (dim = 0; dim < nl->var_rank; dim++)
- pdata = (void*)(pdata + (nl->ls[dim].idx - nl->dim[dim].lbound) *
- nl->dim[dim].stride * nl->size);
+ pdata = (void*)(pdata + (nl->ls[dim].idx
+ - GFC_DESCRIPTOR_LBOUND(nl,dim))
+ * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size);
/* Reset the error flag and try to read next value, if
dtp->u.p.repeat_count=0 */
for (dim=0; dim < nl->var_rank; dim++)
{
nl->ls[dim].step = 1;
- nl->ls[dim].end = nl->dim[dim].ubound;
- nl->ls[dim].start = nl->dim[dim].lbound;
+ nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim);
+ nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim);
nl->ls[dim].idx = nl->ls[dim].start;
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
- stride[n] = iotype == BT_CHARACTER ?
- desc->dim[n].stride * GFC_SIZE_OF_CHAR_KIND(kind) :
- desc->dim[n].stride;
- extent[n] = desc->dim[n].ubound + 1 - desc->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(desc,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(desc,n);
/* If the extent of even one dimension is zero, then the entire
array section contains zero elements, so we return after writing
stride0 = stride[0];
- /* If the innermost dimension has stride 1, we can do the transfer
+ /* If the innermost dimension has a stride of 1, we can do the transfer
in contiguous chunks. */
- if (stride0 == 1)
+ if (stride0 == size)
tsize = extent[0];
else
tsize = 1;
while (data)
{
dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize);
- data += stride0 * size * tsize;
+ data += stride0 * tsize;
count[0] += tsize;
n = 0;
while (count[n] == extent[n])
{
count[n] = 0;
- data -= stride[n] * extent[n] * size;
+ data -= stride[n] * extent[n];
n++;
if (n == rank)
{
else
{
count[n]++;
- data += stride[n] * size;
+ data += stride[n];
}
}
}
for (i=0; i<rank; i++)
{
- ls[i].idx = desc->dim[i].lbound;
- ls[i].start = desc->dim[i].lbound;
- ls[i].end = desc->dim[i].ubound;
- ls[i].step = desc->dim[i].stride;
- empty = empty || (desc->dim[i].ubound < desc->dim[i].lbound);
+ 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));
- if (desc->dim[i].stride > 0)
+ if (GFC_DESCRIPTOR_STRIDE(desc,i) > 0)
{
- index += (desc->dim[i].ubound - desc->dim[i].lbound)
- * desc->dim[i].stride;
+ index += (GFC_DESCRIPTOR_EXTENT(desc,i) - 1)
+ * GFC_DESCRIPTOR_STRIDE(desc,i);
}
else
{
- index -= (desc->dim[i].ubound - desc->dim[i].lbound)
- * desc->dim[i].stride;
- *start_record -= (desc->dim[i].ubound - desc->dim[i].lbound)
- * desc->dim[i].stride;
+ index -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1)
+ * GFC_DESCRIPTOR_STRIDE(desc,i);
+ *start_record -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1)
+ * GFC_DESCRIPTOR_STRIDE(desc,i);
}
}
for (nml = dtp->u.p.ionml; nml->next; nml = nml->next);
- nml->dim[n].stride = stride;
- nml->dim[n].lbound = lbound;
- nml->dim[n].ubound = ubound;
+ GFC_DIMENSION_SET(nml->dim[n],lbound,ubound,stride);
}
/* Reverse memcpy - used for byte swapping. */
nelem = 1;
for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++)
{
- obj->ls[dim_i].idx = obj->dim[dim_i].lbound;
- nelem = nelem * (obj->dim[dim_i].ubound + 1 - obj->dim[dim_i].lbound);
+ obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj, dim_i);
+ nelem = nelem * GFC_DESCRIPTOR_EXTENT (obj, dim_i);
}
/* Main loop to output the data held in the object. */
{
obj->ls[dim_i].idx += nml_carry ;
nml_carry = 0;
- if (obj->ls[dim_i].idx > (index_type) obj->dim[dim_i].ubound)
+ if (obj->ls[dim_i].idx > (ssize_t) GFC_DESCRIPTOR_UBOUND(obj,dim_i))
{
- obj->ls[dim_i].idx = obj->dim[dim_i].lbound;
+ obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i);
nml_carry = 1;
}
}
typedef struct descriptor_dimension
{
- index_type stride;
- index_type lbound;
- index_type ubound;
+ index_type _stride;
+ index_type _lbound;
+ index_type _ubound;
}
+
descriptor_dimension;
#define GFC_ARRAY_DESCRIPTOR(r, type) \
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
+#define GFC_DIMENSION_LBOUND(dim) ((dim)._lbound)
+#define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound)
+#define GFC_DIMENSION_STRIDE(dim) ((dim)._stride)
+#define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim)._lbound)
+#define GFC_DIMENSION_SET(dim,lb,ub,str) \
+ do \
+ { \
+ (dim)._lbound = lb; \
+ (dim)._ubound = ub; \
+ (dim)._stride = str; \
+ } while (0)
+
+
+#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i]._lbound)
+#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
+#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
+ - (desc)->dim[i]._lbound)
+#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))
+
/* Macros to get both the size and the type with a single masking operation */
#define GFC_DTYPE_SIZE_MASK \
{
if (dim == which)
{
- roffset = ret->dim[dim].stride;
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
if (roffset == 0)
roffset = 1;
- soffset = array->dim[dim].stride;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
if (soffset == 0)
soffset = 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride;
- sstride[n] = array->dim[dim].stride;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
n++;
}
}
cshift1 (gfc_array_char * const restrict ret,
const gfc_array_char * const restrict array,
const 'atype` * const restrict h,
- const 'atype_name` * const restrict pwhich,
- index_type size)
+ const 'atype_name` * const restrict pwhich)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
int which;
'atype_name` sh;
index_type arraysize;
+ index_type size;
if (pwhich)
which = *pwhich - 1;
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);
+
arraysize = size0 ((array_t *)array);
if (ret->data == NULL)
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
+ GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
}
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const 'atype` * const restrict h,
const 'atype_name` * const restrict pwhich)
{
- cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const 'atype` * const restrict h,
const 'atype_name` * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length);
+ cshift1 (ret, array, h, pwhich);
}
const gfc_array_char * const restrict array,
const 'atype` * const restrict h,
const 'atype_name` * const restrict pwhich,
- GFC_INTEGER_4 array_length)
+ GFC_INTEGER_4 array_length __attribute__((unused)))
{
- cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t));
+ cshift1 (ret, array, h, pwhich);
}
#endif'
const 'atype` * const restrict h,
const char * const restrict pbound,
const 'atype_name` * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
'atype_name` sh;
'atype_name` delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
n++;
}
}
const char * const restrict pbound,
const 'atype_name` * const restrict pwhich)
{
- eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, "\0", 1);
}
const 'atype` * const restrict h,
const char * const restrict pbound,
const 'atype_name` * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
+ eoshift1 (ret, array, h, pbound, pwhich, " ", 1);
}
const 'atype` * const restrict h,
const char * const restrict pbound,
const 'atype_name` * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ''` ''`;
- eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift1 (ret, array, h, pbound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
const 'atype` * const restrict h,
const gfc_array_char * const restrict bound,
const 'atype_name` * const restrict pwhich,
- index_type size, const char * filler, index_type filler_len)
+ const char * filler, index_type filler_len)
{
/* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS];
index_type dim;
index_type len;
index_type n;
+ index_type size;
int which;
'atype_name` sh;
'atype_name` delta;
soffset = 0;
roffset = 0;
+ size = GFC_DESCRIPTOR_SIZE(array);
+
if (pwhich)
which = *pwhich - 1;
else
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
- ret->dim[i].lbound = 0;
- ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+ index_type ub, str;
+
+ ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
if (i == 0)
- ret->dim[i].stride = 1;
+ str = 1;
else
- ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
+ * GFC_DESCRIPTOR_STRIDE(ret,i-1);
+
+ GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+
}
}
else
{
if (dim == which)
{
- roffset = ret->dim[dim].stride * size;
+ roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
if (roffset == 0)
roffset = size;
- soffset = array->dim[dim].stride * size;
+ soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
if (soffset == 0)
soffset = size;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
}
else
{
count[n] = 0;
- extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
- rstride[n] = ret->dim[dim].stride * size;
- sstride[n] = array->dim[dim].stride * size;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
- hstride[n] = h->dim[n].stride;
+ hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
if (bound)
- bstride[n] = bound->dim[n].stride * size;
+ bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
else
bstride[n] = 0;
n++;
const gfc_array_char * const restrict bound,
const 'atype_name` * const restrict pwhich)
{
- eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array),
- "\0", 1);
+ eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
}
const 'atype` * const restrict h,
const gfc_array_char * const restrict bound,
const 'atype_name` * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
- eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1);
+ eoshift3 (ret, array, h, bound, pwhich, " ", 1);
}
const 'atype` * const restrict h,
const gfc_array_char * const restrict bound,
const 'atype_name` * const restrict pwhich,
- GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 array_length __attribute__((unused)),
GFC_INTEGER_4 bound_length __attribute__((unused)))
{
static const gfc_char4_t space = (unsigned char) ''` ''`;
- eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t),
+ eoshift3 (ret, array, h, bound, pwhich,
(const char *) &space, sizeof (gfc_char4_t));
}
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
runtime_error ("rank of return array in u_name intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" u_name intrnisic: is %ld, should be %ld",
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
runtime_error ("rank of return array in u_name intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" u_name intrnisic: is %ld, should be %ld",
for (n=0; n<rank; n++)
{
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" u_name intrinsic in dimension %ld:"
else
runtime_error ("Funny sized logical array");
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n < rank; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
if (retarray->data == NULL)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = rank-1;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
runtime_error ("rank of return array in u_name intrinsic"
" should be 1, is %ld", (long int) ret_rank);
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
}
- dstride = retarray->dim[0].stride;
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->data;
for (n = 0; n<rank; n++)
dest[n * dstride] = $1 ;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
+
}
else
retarray->data = internal_malloc_size (alloc_size);
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" u_name intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
else
runtime_error ("Funny sized logical array");
- delta = array->dim[dim].stride;
- mdelta = mask->dim[dim].stride * mask_kind;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
- mstride[n] = mask->dim[n + 1].stride * mask_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
- alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
retarray->offset = 0;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" u_name intrinsic in dimension %ld:"
{
index_type mask_extent, array_extent;
- array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
- mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
+ mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" u_name intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" u_name intrinsic in dimension %ld:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->data;
src_kind = GFC_DESCRIPTOR_SIZE (array);
- len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
- delta = array->dim[dim].stride * src_kind;
+ delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
for (n = 0; n < dim; n++)
{
- sstride[n] = array->dim[n].stride * src_kind;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
- sstride[n] = array->dim[n + 1].stride * src_kind;
- extent[n] =
- array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] < 0)
extent[n] = 0;
if (retarray->data == NULL)
{
- size_t alloc_size;
+ size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
- retarray->dim[n].lbound = 0;
- retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
- retarray->dim[n].stride = 1;
+ str = 1;
else
- retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
- alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride
+ alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = -1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
{
index_type ret_extent;
- ret_extent = retarray->dim[n].ubound + 1
- - retarray->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" u_name intrinsic in dimension %d:"
for (n = 0; n < rank; n++)
{
count[n] = 0;
- dstride[n] = retarray->dim[n].stride;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
len = 0;
}
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
/* 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 = retarray->dim[0].stride;
+ rxstride = rystride = GFC_DESCRIPTOR_STRIDE(retarray,0);
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(retarray,1);
}
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
/* Treat it as a a row matrix A[1,count]. */
- axstride = a->dim[0].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
aystride = 1;
xcount = 1;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
}
else
{
- axstride = a->dim[0].stride;
- aystride = a->dim[1].stride;
+ axstride = GFC_DESCRIPTOR_STRIDE(a,0);
+ aystride = GFC_DESCRIPTOR_STRIDE(a,1);
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
- if (count != b->dim[0].ubound + 1 - b->dim[0].lbound)
+ if (count != GFC_DESCRIPTOR_EXTENT(b,0))
{
- if (count > 0 || b->dim[0].ubound + 1 - b->dim[0].lbound > 0)
+ if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0)
runtime_error ("dimension of array B incorrect in MATMUL intrinsic");
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
/* Treat it as a column matrix B[count,1] */
- bxstride = b->dim[0].stride;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
/* bystride should never be used for 1-dimensional b.
in case it is we want it to cause a segfault, rather than
}
else
{
- bxstride = b->dim[0].stride;
- bystride = b->dim[1].stride;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bxstride = GFC_DESCRIPTOR_STRIDE(b,0);
+ bystride = GFC_DESCRIPTOR_STRIDE(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
abase = a->data;
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1);
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
}
else
{
- retarray->dim[0].lbound = 0;
- retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
- retarray->dim[0].stride = 1;
-
- retarray->dim[1].lbound = 0;
- retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
- retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ GFC_DIMENSION_SET(retarray->dim[0], 0,
+ GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1);
+
+ GFC_DIMENSION_SET(retarray->dim[1], 0,
+ GFC_DESCRIPTOR_EXTENT(b,1) - 1,
+ GFC_DESCRIPTOR_EXTENT(retarray,0));
}
retarray->data
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic: is %ld, should be %ld",
}
else
{
- arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
- ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(a,0);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 1:"
" is %ld, should be %ld",
(long int) ret_extent, (long int) arg_extent);
- arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
- ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ arg_extent = GFC_DESCRIPTOR_EXTENT(b,1);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1);
if (arg_extent != ret_extent)
runtime_error ("Incorrect extent in return array in"
" MATMUL intrinsic for dimension 2:"
`
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
{
- rxstride = retarray->dim[0].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
rystride = rxstride;
}
else
{
- rxstride = retarray->dim[0].stride;
- rystride = retarray->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(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 = a->dim[0].stride * a_kind;
- count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ count = GFC_DESCRIPTOR_EXTENT(a,0);
xstride = 0;
rxstride = 0;
xcount = 1;
}
else
{
- astride = a->dim[1].stride * a_kind;
- count = a->dim[1].ubound + 1 - a->dim[1].lbound;
- xstride = a->dim[0].stride * a_kind;
- xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1);
+ count = GFC_DESCRIPTOR_EXTENT(a,1);
+ xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0);
+ xcount = GFC_DESCRIPTOR_EXTENT(a,0);
}
if (GFC_DESCRIPTOR_RANK (b) == 1)
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
ystride = 0;
rystride = 0;
ycount = 1;
}
else
{
- bstride = b->dim[0].stride * b_kind;
- assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
- ystride = b->dim[1].stride * b_kind;
- ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0);
+ assert(count == GFC_DESCRIPTOR_EXTENT(b,0));
+ ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1);
+ ycount = GFC_DESCRIPTOR_EXTENT(b,1);
}
for (y = 0; y < ycount; y++)
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
zero_sized = 1;
- sstride[n] = array->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (sstride[0] == 0)
sstride[0] = 1;
{
/* The return array will have as many
elements as there are in VECTOR. */
- total = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ total = GFC_DESCRIPTOR_EXTENT(vector,0);
if (total < 0)
{
total = 0;
if (ret->data == NULL)
{
/* Setup the array descriptor. */
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = total - 1;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
ret->offset = 0;
if (total == 0)
/* We come here because of range checking. */
index_type ret_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
if (total != ret_extent)
runtime_error ("Incorrect extent in return value of PACK intrinsic;"
" is %ld, should be %ld", (long int) total,
}
}
- rstride0 = ret->dim[0].stride;
+ rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0);
if (rstride0 == 0)
rstride0 = 1;
sstride0 = sstride[0];
/* Add any remaining elements from VECTOR. */
if (vector)
{
- n = vector->dim[0].ubound + 1 - vector->dim[0].lbound;
+ n = GFC_DESCRIPTOR_EXTENT(vector,0);
nelem = ((rptr - ret->data) / rstride0);
if (n > nelem)
{
- sstride0 = vector->dim[0].stride;
+ sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (sstride0 == 0)
sstride0 = 1;
-`/* Implementation of the RESHAPE
+`/* Implementation of the RESHAPE intrinsic
Copyright 2002, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
int sempty, pempty, shape_empty;
index_type shape_data[GFC_MAX_DIMENSIONS];
- rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
if (rdim != GFC_DESCRIPTOR_RANK(ret))
runtime_error("rank of return array incorrect in RESHAPE intrinsic");
for (n = 0; n < rdim; n++)
{
- shape_data[n] = shape->data[n * shape->dim[0].stride];
+ shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
if (shape_data[n] <= 0)
{
shape_data[n] = 0;
rs = 1;
for (n = 0; n < rdim; n++)
{
- ret->dim[n].lbound = 0;
rex = shape_data[n];
- ret->dim[n].ubound = rex - 1;
- ret->dim[n].stride = rs;
+
+ GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
+
rs *= rex;
}
ret->offset = 0;
for (n = 0; n < pdim; n++)
{
pcount[n] = 0;
- pstride[n] = pad->dim[n].stride;
- pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
+ pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
if (pextent[n] <= 0)
{
pempty = 1;
for (n = 0; n < rdim; n++)
{
rs *= shape_data[n];
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (ret_extent != shape_data[n])
runtime_error("Incorrect extent in return value of RESHAPE"
" intrinsic in dimension %ld: is %ld,"
for (n = 0; n < sdim; n++)
{
index_type se;
- se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ se = GFC_DESCRIPTOR_EXTENT(source,n);
source_extent *= se > 0 ? se : 0;
}
for (n = 0; n < rdim; n++)
{
- v = order->data[n * order->dim[0].stride] - 1;
+ v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
if (v < 0 || v >= rdim)
runtime_error("Value %ld out of range in ORDER argument"
for (n = 0; n < rdim; n++)
{
if (order)
- dim = order->data[n * order->dim[0].stride] - 1;
+ dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
else
dim = n;
rcount[n] = 0;
- rstride[n] = ret->dim[dim].stride;
- rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
if (rextent[n] < 0)
rextent[n] = 0;
for (n = 0; n < sdim; n++)
{
scount[n] = 0;
- sstride[n] = source->dim[n].stride;
- sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (sextent[n] <= 0)
{
sempty = 1;
index_type stride;
index_type extent;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
- if (ret->dim[0].ubound < ret->dim[0].lbound)
+ if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
return;
for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
{
- extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ extent = GFC_DESCRIPTOR_EXTENT(array,n);
ret->data[n * stride] = extent > 0 ? extent : 0 ;
}
}
if (ret->data == NULL)
{
+
+ size_t ub, stride;
+
/* The front end has signalled that we need to populate the
return array descriptor. */
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
rs = 1;
for (n = 0; n < rrank; n++)
{
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
+ stride = rs;
if (n == along - 1)
{
- ret->dim[n].ubound = ncopies - 1;
+ ub = ncopies - 1;
rdelta = rs;
rs *= ncopies;
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
- sstride[dim] = source->dim[dim].stride;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
rstride[dim] = rs;
- ret->dim[n].ubound = extent[dim]-1;
+ ub = extent[dim] - 1;
rs *= extent[dim];
dim++;
}
+ GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);
}
ret->offset = 0;
if (rs > 0)
{
index_type ret_extent;
- ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
if (ret_extent != ncopies)
runtime_error("Incorrect extent in return value of SPREAD"
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (ret_extent != extent[dim])
runtime_error("Incorrect extent in return value of SPREAD"
" intrinsic in dimension %ld: is %ld,"
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
if (n == along - 1)
{
- rdelta = ret->dim[n].stride;
+ rdelta = GFC_DESCRIPTOR_STRIDE(ret,n);
}
else
{
count[dim] = 0;
- extent[dim] = source->dim[dim].ubound + 1
- - source->dim[dim].lbound;
+ extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);
if (extent[dim] <= 0)
zero_sized = 1;
- sstride[dim] = source->dim[dim].stride;
- rstride[dim] = ret->dim[n].stride;
+ sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim);
+ rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n);
dim++;
}
}
{
ret->data = internal_malloc_size (ncopies * sizeof ('rtype_name`));
ret->offset = 0;
- ret->dim[0].stride = 1;
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = ncopies - 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1);
}
else
{
- if (ncopies - 1 > (ret->dim[0].ubound - ret->dim[0].lbound)
- / ret->dim[0].stride)
+ if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1)
+ / GFC_DESCRIPTOR_STRIDE(ret,0))
runtime_error ("dim too large in spread()");
}
dest = ret->data;
- stride = ret->dim[0].stride;
+ stride = GFC_DESCRIPTOR_STRIDE(ret,0);
for (n = 0; n < ncopies; n++)
{
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
- ret->dim[0].lbound = 0;
- ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
- ret->dim[0].stride = 1;
+ GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1,
+ 1);
- ret->dim[1].lbound = 0;
- ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
- ret->dim[1].stride = ret->dim[0].ubound+1;
+ GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1,
+ GFC_DESCRIPTOR_EXTENT(source, 1));
ret->data = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) ret));
ret->offset = 0;
{
index_type ret_extent, src_extent;
- ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
- src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,1);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
" should be %ld", (long int) src_extent,
(long int) ret_extent);
- ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
- src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1);
+ src_extent = GFC_DESCRIPTOR_EXTENT(source,0);
if (src_extent != ret_extent)
runtime_error ("Incorrect extent in return value of TRANSPOSE"
}
- sxstride = source->dim[0].stride;
- systride = source->dim[1].stride;
- xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
- ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+ sxstride = GFC_DESCRIPTOR_STRIDE(source,0);
+ systride = GFC_DESCRIPTOR_STRIDE(source,1);
+ xcount = GFC_DESCRIPTOR_EXTENT(source,0);
+ ycount = GFC_DESCRIPTOR_EXTENT(source,1);
- rxstride = ret->dim[0].stride;
- rystride = ret->dim[1].stride;
+ rxstride = GFC_DESCRIPTOR_STRIDE(ret,0);
+ rystride = GFC_DESCRIPTOR_STRIDE(ret,1);
rptr = ret->data;
sptr = source->data;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
for (n = 0; n < dim; n++)
{
count[n] = 0;
- ret->dim[n].stride = rs;
- ret->dim[n].lbound = 0;
- ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
- extent[n] = ret->dim[n].ubound + 1;
+ GFC_DIMENSION_SET(ret->dim[n], 0,
+ GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
rs *= extent[n];
}
ret->offset = 0;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
empty = empty || extent[n] <= 0;
- rstride[n] = ret->dim[n].stride;
- fstride[n] = field->dim[n].stride;
- mstride[n] = mask->dim[n].stride * mask_kind;
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
+ fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (rstride[0] == 0)
rstride[0] = 1;
if (mstride[0] == 0)
mstride[0] = 1;
- vstride0 = vector->dim[0].stride;
+ vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
if (vstride0 == 0)
vstride0 = 1;
rstride0 = rstride[0];
index_type size;
index_type type_size;
- if (source->dim[0].stride == 0)
- {
- source->dim[0].stride = 1;
- return source->data;
- }
-
type_size = GFC_DTYPE_TYPE_SIZE(source);
size = GFC_DESCRIPTOR_SIZE (source);
switch (type_size)
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = source->dim[n].stride;
- extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
if (extent[n] <= 0)
{
/* Do nothing. */
size = GFC_DESCRIPTOR_SIZE (d);
- if (d->dim[0].stride == 0)
- d->dim[0].stride = 1;
-
dim = GFC_DESCRIPTOR_RANK (d);
dsize = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
- stride[n] = d->dim[n].stride;
- extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
if (extent[n] <= 0)
return;
OSDN Git Service
