diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2009-06-21 19:24:55 +0000 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2009-06-21 19:24:55 +0000 |
commit | dfb55fdcdb68bba326432b26f3828ff8c9ca2990 (patch) | |
tree | 0f6ecc4005b1035630f9b5894ef6e31b9a0fc204 /libgfortran/intrinsics | |
parent | ee372c4b96b57028beb3c22db6a8283916df15a6 (diff) | |
download | gcc-dfb55fdcdb68bba326432b26f3828ff8c9ca2990.zip gcc-dfb55fdcdb68bba326432b26f3828ff8c9ca2990.tar.gz gcc-dfb55fdcdb68bba326432b26f3828ff8c9ca2990.tar.bz2 |
re PR fortran/37577 ([meta-bug] change internal array descriptor format for better syntax, C interop TR, rank 15)
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.
From-SVN: r148769
Diffstat (limited to 'libgfortran/intrinsics')
-rw-r--r-- | libgfortran/intrinsics/associated.c | 10 | ||||
-rw-r--r-- | libgfortran/intrinsics/cshift0.c | 54 | ||||
-rw-r--r-- | libgfortran/intrinsics/date_and_time.c | 40 | ||||
-rw-r--r-- | libgfortran/intrinsics/dtime.c | 4 | ||||
-rw-r--r-- | libgfortran/intrinsics/eoshift0.c | 25 | ||||
-rw-r--r-- | libgfortran/intrinsics/eoshift2.c | 42 | ||||
-rw-r--r-- | libgfortran/intrinsics/etime.c | 4 | ||||
-rw-r--r-- | libgfortran/intrinsics/iso_c_binding.c | 37 | ||||
-rw-r--r-- | libgfortran/intrinsics/move_alloc.c | 10 | ||||
-rw-r--r-- | libgfortran/intrinsics/pack_generic.c | 37 | ||||
-rw-r--r-- | libgfortran/intrinsics/random.c | 32 | ||||
-rw-r--r-- | libgfortran/intrinsics/reshape_generic.c | 31 | ||||
-rw-r--r-- | libgfortran/intrinsics/size.c | 4 | ||||
-rw-r--r-- | libgfortran/intrinsics/spread_generic.c | 86 | ||||
-rw-r--r-- | libgfortran/intrinsics/stat.c | 140 | ||||
-rw-r--r-- | libgfortran/intrinsics/transpose_generic.c | 48 | ||||
-rw-r--r-- | libgfortran/intrinsics/unpack_generic.c | 23 |
17 files changed, 328 insertions, 299 deletions
diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c index 87b449e..0aade1d 100644 --- a/libgfortran/intrinsics/associated.c +++ b/libgfortran/intrinsics/associated.c @@ -43,14 +43,14 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target) 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; } diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index be0444a..1b7dbc1c 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -1,5 +1,5 @@ /* 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). @@ -7,21 +7,26 @@ 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> @@ -30,7 +35,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 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]; @@ -66,14 +71,17 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, 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) @@ -278,20 +286,20 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, { 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++; } } @@ -306,7 +314,7 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, 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; diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c index be64626..4bc6e69 100644 --- a/libgfortran/intrinsics/date_and_time.c +++ b/libgfortran/intrinsics/date_and_time.c @@ -265,8 +265,8 @@ date_and_time (char *__date, char *__time, char *__zone, 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; @@ -351,9 +351,7 @@ secnds (GFC_REAL_4 *x) & 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); @@ -411,9 +409,9 @@ itime_i4 (gfc_array_i4 *__values) 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; @@ -437,9 +435,9 @@ itime_i8 (gfc_array_i8 *__values) 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; @@ -493,9 +491,9 @@ idate_i4 (gfc_array_i4 *__values) 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; @@ -519,9 +517,9 @@ idate_i8 (gfc_array_i8 *__values) 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; @@ -583,9 +581,9 @@ gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) 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; @@ -610,9 +608,9 @@ gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) 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; @@ -675,9 +673,9 @@ ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) 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; @@ -702,9 +700,9 @@ ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) 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; diff --git a/libgfortran/intrinsics/dtime.c b/libgfortran/intrinsics/dtime.c index 40028a6..4b7000b 100644 --- a/libgfortran/intrinsics/dtime.c +++ b/libgfortran/intrinsics/dtime.c @@ -42,7 +42,7 @@ dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) 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); @@ -62,7 +62,7 @@ dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) 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); diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 6ac7c94..4b8082f 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -70,13 +70,18 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, 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 @@ -96,20 +101,20 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, { 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++; } } diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c index 763545a..aa5ef5a 100644 --- a/libgfortran/intrinsics/eoshift2.c +++ b/libgfortran/intrinsics/eoshift2.c @@ -34,7 +34,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 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]; @@ -59,6 +59,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, 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. */ @@ -66,6 +67,8 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, soffset = 0; roffset = 0; + size = GFC_DESCRIPTOR_SIZE (array); + arraysize = size0 ((array_t *) array); if (ret->data == NULL) @@ -77,13 +80,18 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, 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 @@ -107,22 +115,22 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, { 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++; @@ -256,7 +264,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, 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, \ @@ -274,11 +282,11 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, 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, \ @@ -296,12 +304,12 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, 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)); \ } diff --git a/libgfortran/intrinsics/etime.c b/libgfortran/intrinsics/etime.c index 1ae357e..b0fd742 100644 --- a/libgfortran/intrinsics/etime.c +++ b/libgfortran/intrinsics/etime.c @@ -35,7 +35,7 @@ etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) 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) @@ -54,7 +54,7 @@ etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) tp = t->data; *tp = tu; - tp += t->dim[0].stride; + tp += GFC_DESCRIPTOR_STRIDE(t,0); *tp = ts; *result = tt; } diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c index 38f0775..bb25e3e 100644 --- a/libgfortran/intrinsics/iso_c_binding.c +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -75,9 +75,8 @@ ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in, /* 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 @@ -104,51 +103,51 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, 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; diff --git a/libgfortran/intrinsics/move_alloc.c b/libgfortran/intrinsics/move_alloc.c index 527aa6f..9b5497c 100644 --- a/libgfortran/intrinsics/move_alloc.c +++ b/libgfortran/intrinsics/move_alloc.c @@ -42,11 +42,11 @@ move_alloc (gfc_array_char * from, gfc_array_char * to) 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; diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c index 4c89dad..b611d77 100644 --- a/libgfortran/intrinsics/pack_generic.c +++ b/libgfortran/intrinsics/pack_generic.c @@ -121,11 +121,11 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, 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; @@ -141,7 +141,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, { /* 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 { @@ -204,9 +204,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, 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) @@ -223,7 +221,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, /* 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, @@ -231,7 +229,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, } } - rstride0 = ret->dim[0].stride * size; + rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); if (rstride0 == 0) rstride0 = size; sstride0 = sstride[0]; @@ -280,11 +278,11 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, /* 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; @@ -511,11 +509,11 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, 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) @@ -536,7 +534,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, { /* 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; @@ -559,9 +557,8 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, } /* 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) @@ -573,7 +570,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, 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; @@ -623,11 +620,11 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, /* 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; diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c index 0d1f25f..803049b 100644 --- a/libgfortran/intrinsics/random.c +++ b/libgfortran/intrinsics/random.c @@ -374,8 +374,8 @@ arandom_r4 (gfc_array_r4 *x) 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; } @@ -441,8 +441,8 @@ arandom_r8 (gfc_array_r8 *x) 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; } @@ -511,8 +511,8 @@ arandom_r10 (gfc_array_r10 *x) 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; } @@ -583,8 +583,8 @@ arandom_r16 (gfc_array_r16 *x) 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; } @@ -690,13 +690,13 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) 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 @@ -712,7 +712,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) 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. */ @@ -720,7 +720,7 @@ random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) /* 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)); } @@ -757,12 +757,12 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get) 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)); } @@ -774,12 +774,12 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get) 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)); } diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c index 0f30227..bb1552aa 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -67,7 +67,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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"); @@ -75,7 +75,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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; @@ -85,14 +85,13 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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; @@ -111,8 +110,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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; @@ -142,7 +141,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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," @@ -155,7 +154,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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; } @@ -174,7 +173,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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" @@ -193,13 +192,13 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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"); @@ -218,8 +217,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, 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; diff --git a/libgfortran/intrinsics/size.c b/libgfortran/intrinsics/size.c index 9aa4cd9..6127c4e 100644 --- a/libgfortran/intrinsics/size.c +++ b/libgfortran/intrinsics/size.c @@ -35,7 +35,7 @@ size0 (const array_t * array) 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; @@ -54,7 +54,7 @@ size1 (const array_t * array, index_type dim) dim--; - size = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + size = GFC_DESCRIPTOR_EXTENT(array,dim); if (size < 0) size = 0; return size; diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c index 9fb4b11..9e20b85 100644 --- a/libgfortran/intrinsics/spread_generic.c +++ b/libgfortran/intrinsics/spread_generic.c @@ -30,8 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 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]; @@ -52,6 +51,9 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, index_type n; index_type dim; index_type ncopies; + index_type size; + + size = GFC_DESCRIPTOR_SIZE(source); srank = GFC_DESCRIPTOR_RANK(source); @@ -68,31 +70,34 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, { /* The front end has signalled that we need to populate the return array descriptor. */ + + size_t ub, stride; + 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) @@ -119,10 +124,10 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, { 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" @@ -133,8 +138,7 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, 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," @@ -144,8 +148,8 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, 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++; } } @@ -156,17 +160,16 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, { 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++; } } @@ -228,12 +231,14 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, 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()"); @@ -245,20 +250,18 @@ spread_internal_scalar (gfc_array_char *ret, const char *source, { 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); } } @@ -400,7 +403,7 @@ spread (gfc_array_char *ret, const gfc_array_char *source, #endif } - spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source)); + spread_internal (ret, source, along, pncopies); } @@ -413,9 +416,10 @@ void 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); } @@ -428,10 +432,10 @@ void 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); } @@ -577,7 +581,7 @@ spread_scalar (gfc_array_char *ret, const char *source, #endif } - spread_internal_scalar (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (ret)); + spread_internal_scalar (ret, source, along, pncopies); } @@ -590,11 +594,12 @@ void 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); } @@ -607,11 +612,12 @@ void 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); + } diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c index 5d0f3b63..22d4f79 100644 --- a/libgfortran/intrinsics/stat.c +++ b/libgfortran/intrinsics/stat.c @@ -66,7 +66,7 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, 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. */ @@ -88,55 +88,57 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, 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 } @@ -185,7 +187,7 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, 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. */ @@ -207,55 +209,57 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, 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 } @@ -376,7 +380,7 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray, GFC_INTEGER_4 *status) 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. */ @@ -386,55 +390,57 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray, GFC_INTEGER_4 *status) 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 } @@ -457,7 +463,7 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8 *status) 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. */ @@ -467,55 +473,57 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8 *status) 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 } diff --git a/libgfortran/intrinsics/transpose_generic.c b/libgfortran/intrinsics/transpose_generic.c index 2585619..b0c2fff 100644 --- a/libgfortran/intrinsics/transpose_generic.c +++ b/libgfortran/intrinsics/transpose_generic.c @@ -32,8 +32,7 @@ extern void transpose (gfc_array_char *, gfc_array_char *); 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; @@ -44,21 +43,22 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, 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; @@ -67,8 +67,8 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, { 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" @@ -76,8 +76,8 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, " 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" @@ -87,13 +87,13 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source, } - 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; @@ -119,7 +119,7 @@ export_proto(transpose); void transpose (gfc_array_char *ret, gfc_array_char *source) { - transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source)); + transpose_internal (ret, source); } @@ -130,9 +130,10 @@ export_proto(transpose_char); 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); } @@ -143,7 +144,8 @@ export_proto(transpose_char4); 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); } diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c index a27e37c..47d4a6d 100644 --- a/libgfortran/intrinsics/unpack_generic.c +++ b/libgfortran/intrinsics/unpack_generic.c @@ -89,14 +89,13 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, 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; @@ -108,11 +107,11 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, 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; @@ -126,7 +125,7 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, 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]; |