mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-11 13:01:20 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/37577 ([meta-bug] change internal array descriptor format for better syntax, C interop TR, rank 15)

Browse Source 
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
This commit is contained in:
Thomas Koenig 2009-06-21 19:24:55 +00:00
parent ee372c4b96
commit dfb55fdcdb
336 changed files with 9238 additions and 9583 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

452
libgfortran/ChangeLog
View File

@ -1,3 +1,455 @@
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.

34
libgfortran/generated/all_l1.c
View File

@ -60,25 +60,24 @@ all_l1 (gfc_array_l1 * const restrict retarray,
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;
@ -86,29 +85,29 @@ all_l1 (gfc_array_l1 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ all_l1 (gfc_array_l1 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ all_l1 (gfc_array_l1 * const restrict retarray,
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;
}

34
libgfortran/generated/all_l16.c
View File

@ -60,25 +60,24 @@ all_l16 (gfc_array_l16 * const restrict retarray,
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;
@ -86,29 +85,29 @@ all_l16 (gfc_array_l16 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ all_l16 (gfc_array_l16 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ all_l16 (gfc_array_l16 * const restrict retarray,
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;
}

34
libgfortran/generated/all_l2.c
View File

@ -60,25 +60,24 @@ all_l2 (gfc_array_l2 * const restrict retarray,
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;
@ -86,29 +85,29 @@ all_l2 (gfc_array_l2 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ all_l2 (gfc_array_l2 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ all_l2 (gfc_array_l2 * const restrict retarray,
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;
}

34
libgfortran/generated/all_l4.c
View File

@ -60,25 +60,24 @@ all_l4 (gfc_array_l4 * const restrict retarray,
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;
@ -86,29 +85,29 @@ all_l4 (gfc_array_l4 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ all_l4 (gfc_array_l4 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ all_l4 (gfc_array_l4 * const restrict retarray,
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;
}

34
libgfortran/generated/all_l8.c
View File

@ -60,25 +60,24 @@ all_l8 (gfc_array_l8 * const restrict retarray,
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;
@ -86,29 +85,29 @@ all_l8 (gfc_array_l8 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ all_l8 (gfc_array_l8 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ all_l8 (gfc_array_l8 * const restrict retarray,
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;
}

34
libgfortran/generated/any_l1.c
View File

@ -60,25 +60,24 @@ any_l1 (gfc_array_l1 * const restrict retarray,
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;
@ -86,29 +85,29 @@ any_l1 (gfc_array_l1 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ any_l1 (gfc_array_l1 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ any_l1 (gfc_array_l1 * const restrict retarray,
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;
}

34
libgfortran/generated/any_l16.c
View File

@ -60,25 +60,24 @@ any_l16 (gfc_array_l16 * const restrict retarray,
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;
@ -86,29 +85,29 @@ any_l16 (gfc_array_l16 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ any_l16 (gfc_array_l16 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ any_l16 (gfc_array_l16 * const restrict retarray,
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;
}

34
libgfortran/generated/any_l2.c
View File

@ -60,25 +60,24 @@ any_l2 (gfc_array_l2 * const restrict retarray,
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;
@ -86,29 +85,29 @@ any_l2 (gfc_array_l2 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ any_l2 (gfc_array_l2 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ any_l2 (gfc_array_l2 * const restrict retarray,
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;
}

34
libgfortran/generated/any_l4.c
View File

@ -60,25 +60,24 @@ any_l4 (gfc_array_l4 * const restrict retarray,
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;
@ -86,29 +85,29 @@ any_l4 (gfc_array_l4 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ any_l4 (gfc_array_l4 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ any_l4 (gfc_array_l4 * const restrict retarray,
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;
}

34
libgfortran/generated/any_l8.c
View File

@ -60,25 +60,24 @@ any_l8 (gfc_array_l8 * const restrict retarray,
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;
@ -86,29 +85,29 @@ any_l8 (gfc_array_l8 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ any_l8 (gfc_array_l8 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ any_l8 (gfc_array_l8 * const restrict retarray,
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;
}

34
libgfortran/generated/count_16_l.c
View File

@ -60,25 +60,24 @@ count_16_l (gfc_array_i16 * const restrict retarray,
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;
@ -86,29 +85,29 @@ count_16_l (gfc_array_i16 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ count_16_l (gfc_array_i16 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ count_16_l (gfc_array_i16 * const restrict retarray,
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;
}

34
libgfortran/generated/count_1_l.c
View File

@ -60,25 +60,24 @@ count_1_l (gfc_array_i1 * const restrict retarray,
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;
@ -86,29 +85,29 @@ count_1_l (gfc_array_i1 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ count_1_l (gfc_array_i1 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ count_1_l (gfc_array_i1 * const restrict retarray,
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;
}

34
libgfortran/generated/count_2_l.c
View File

@ -60,25 +60,24 @@ count_2_l (gfc_array_i2 * const restrict retarray,
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;
@ -86,29 +85,29 @@ count_2_l (gfc_array_i2 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ count_2_l (gfc_array_i2 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ count_2_l (gfc_array_i2 * const restrict retarray,
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;
}

34
libgfortran/generated/count_4_l.c
View File

@ -60,25 +60,24 @@ count_4_l (gfc_array_i4 * const restrict retarray,
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;
@ -86,29 +85,29 @@ count_4_l (gfc_array_i4 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ count_4_l (gfc_array_i4 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ count_4_l (gfc_array_i4 * const restrict retarray,
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;
}

34
libgfortran/generated/count_8_l.c
View File

@ -60,25 +60,24 @@ count_8_l (gfc_array_i8 * const restrict retarray,
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;
@ -86,29 +85,29 @@ count_8_l (gfc_array_i8 * const restrict retarray,
if (retarray->data == NULL)
{
size_t alloc_size;
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
str = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * 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
@ -128,8 +127,7 @@ count_8_l (gfc_array_i8 * const restrict retarray,
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- 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:"
@ -142,7 +140,7 @@ count_8_l (gfc_array_i8 * const restrict retarray,
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;
}

12
libgfortran/generated/cshift0_c10.c
View File

@ -69,20 +69,20 @@ cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_c16.c
View File

@ -69,20 +69,20 @@ cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_c4.c
View File

@ -69,20 +69,20 @@ cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_c8.c
View File

@ -69,20 +69,20 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_i1.c
View File

@ -69,20 +69,20 @@ cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_i16.c
View File

@ -69,20 +69,20 @@ cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_i2.c
View File

@ -69,20 +69,20 @@ cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_i4.c
View File

@ -69,20 +69,20 @@ cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_i8.c
View File

@ -69,20 +69,20 @@ cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_r10.c
View File

@ -69,20 +69,20 @@ cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_r16.c
View File

@ -69,20 +69,20 @@ cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_r4.c
View File

@ -69,20 +69,20 @@ cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ssize_t shift,
{
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++;
}
}

12
libgfortran/generated/cshift0_r8.c
View File

@ -69,20 +69,20 @@ cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ssize_t shift,
{
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++;
}
}

42
libgfortran/generated/cshift1_16.c
View File

@ -35,8 +35,7 @@ static void
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];
@ -63,6 +62,7 @@ cshift1 (gfc_array_char * const restrict ret,
int which;
GFC_INTEGER_16 sh;
index_type arraysize;
index_type size;
if (pwhich)
which = *pwhich - 1;
@ -72,6 +72,8 @@ cshift1 (gfc_array_char * const restrict ret,
if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
size = GFC_DESCRIPTOR_SIZE(array);
arraysize = size0 ((array_t *)array);
if (ret->data == NULL)
@ -83,13 +85,17 @@ cshift1 (gfc_array_char * const restrict ret,
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);
}
}
@ -109,22 +115,22 @@ cshift1 (gfc_array_char * const restrict ret,
{
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++;
}
}
@ -210,7 +216,7 @@ cshift1_16 (gfc_array_char * const restrict ret,
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);
}
@ -228,9 +234,9 @@ cshift1_16_char (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,
GFC_INTEGER_4 array_length)
GFC_INTEGER_4 array_length __attribute__((unused)))
{
cshift1 (ret, array, h, pwhich, array_length);
cshift1 (ret, array, h, pwhich);
}
@ -248,9 +254,9 @@ cshift1_16_char4 (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,
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

42
libgfortran/generated/cshift1_4.c
View File

@ -35,8 +35,7 @@ static void
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];
@ -63,6 +62,7 @@ cshift1 (gfc_array_char * const restrict ret,
int which;
GFC_INTEGER_4 sh;
index_type arraysize;
index_type size;
if (pwhich)
which = *pwhich - 1;
@ -72,6 +72,8 @@ cshift1 (gfc_array_char * const restrict ret,
if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
size = GFC_DESCRIPTOR_SIZE(array);
arraysize = size0 ((array_t *)array);
if (ret->data == NULL)
@ -83,13 +85,17 @@ cshift1 (gfc_array_char * const restrict ret,
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);
}
}
@ -109,22 +115,22 @@ cshift1 (gfc_array_char * const restrict ret,
{
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++;
}
}
@ -210,7 +216,7 @@ cshift1_4 (gfc_array_char * const restrict ret,
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);
}
@ -228,9 +234,9 @@ cshift1_4_char (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,
GFC_INTEGER_4 array_length)
GFC_INTEGER_4 array_length __attribute__((unused)))
{
cshift1 (ret, array, h, pwhich, array_length);
cshift1 (ret, array, h, pwhich);
}
@ -248,9 +254,9 @@ cshift1_4_char4 (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,
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

42
libgfortran/generated/cshift1_8.c
View File

@ -35,8 +35,7 @@ static void
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];
@ -63,6 +62,7 @@ cshift1 (gfc_array_char * const restrict ret,
int which;
GFC_INTEGER_8 sh;
index_type arraysize;
index_type size;
if (pwhich)
which = *pwhich - 1;
@ -72,6 +72,8 @@ cshift1 (gfc_array_char * const restrict ret,
if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
size = GFC_DESCRIPTOR_SIZE(array);
arraysize = size0 ((array_t *)array);
if (ret->data == NULL)
@ -83,13 +85,17 @@ cshift1 (gfc_array_char * const restrict ret,
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);
}
}
@ -109,22 +115,22 @@ cshift1 (gfc_array_char * const restrict ret,
{
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++;
}
}
@ -210,7 +216,7 @@ cshift1_8 (gfc_array_char * const restrict ret,
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);
}
@ -228,9 +234,9 @@ cshift1_8_char (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,
GFC_INTEGER_4 array_length)
GFC_INTEGER_4 array_length __attribute__((unused)))
{
cshift1 (ret, array, h, pwhich, array_length);
cshift1 (ret, array, h, pwhich);
}
@ -248,9 +254,9 @@ cshift1_8_char4 (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,
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

43
libgfortran/generated/eoshift1_16.c
View File

@ -37,7 +37,7 @@ eoshift1 (gfc_array_char * const restrict ret,
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];
@ -61,6 +61,7 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type dim;
index_type len;
index_type n;
index_type size;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
@ -71,6 +72,8 @@ eoshift1 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
which = *pwhich - 1;
else
@ -88,13 +91,18 @@ eoshift1 (gfc_array_char * const restrict ret,
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
@ -108,22 +116,22 @@ eoshift1 (gfc_array_char * const restrict ret,
{
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++;
}
}
@ -241,8 +249,7 @@ eoshift1_16 (gfc_array_char * const restrict ret,
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);
}
@ -262,10 +269,10 @@ eoshift1_16_char (gfc_array_char * const restrict ret,
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);
}
@ -285,11 +292,11 @@ eoshift1_16_char4 (gfc_array_char * const restrict ret,
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));
}

43
libgfortran/generated/eoshift1_4.c
View File

@ -37,7 +37,7 @@ eoshift1 (gfc_array_char * const restrict ret,
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];
@ -61,6 +61,7 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type dim;
index_type len;
index_type n;
index_type size;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
@ -71,6 +72,8 @@ eoshift1 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
which = *pwhich - 1;
else
@ -88,13 +91,18 @@ eoshift1 (gfc_array_char * const restrict ret,
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
@ -108,22 +116,22 @@ eoshift1 (gfc_array_char * const restrict ret,
{
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++;
}
}
@ -241,8 +249,7 @@ eoshift1_4 (gfc_array_char * const restrict ret,
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);
}
@ -262,10 +269,10 @@ eoshift1_4_char (gfc_array_char * const restrict ret,
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);
}
@ -285,11 +292,11 @@ eoshift1_4_char4 (gfc_array_char * const restrict ret,
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));
}

43
libgfortran/generated/eoshift1_8.c
View File

@ -37,7 +37,7 @@ eoshift1 (gfc_array_char * const restrict ret,
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];
@ -61,6 +61,7 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type dim;
index_type len;
index_type n;
index_type size;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
@ -71,6 +72,8 @@ eoshift1 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
which = *pwhich - 1;
else
@ -88,13 +91,18 @@ eoshift1 (gfc_array_char * const restrict ret,
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
@ -108,22 +116,22 @@ eoshift1 (gfc_array_char * const restrict ret,
{
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++;
}
}
@ -241,8 +249,7 @@ eoshift1_8 (gfc_array_char * const restrict ret,
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);
}
@ -262,10 +269,10 @@ eoshift1_8_char (gfc_array_char * const restrict ret,
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);
}
@ -285,11 +292,11 @@ eoshift1_8_char4 (gfc_array_char * const restrict ret,
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));
}

45
libgfortran/generated/eoshift3_16.c
View File

@ -37,7 +37,7 @@ eoshift3 (gfc_array_char * const restrict ret,
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];
@ -65,6 +65,7 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type dim;
index_type len;
index_type n;
index_type size;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
@ -75,6 +76,8 @@ eoshift3 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
which = *pwhich - 1;
else
@ -89,13 +92,18 @@ eoshift3 (gfc_array_char * const restrict ret,
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
@ -112,24 +120,24 @@ eoshift3 (gfc_array_char * const restrict ret,
{
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++;
@ -260,8 +268,7 @@ eoshift3_16 (gfc_array_char * const restrict ret,
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);
}
@ -281,10 +288,10 @@ eoshift3_16_char (gfc_array_char * const restrict ret,
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);
}
@ -304,11 +311,11 @@ eoshift3_16_char4 (gfc_array_char * const restrict ret,
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));
}

45
libgfortran/generated/eoshift3_4.c
View File

@ -37,7 +37,7 @@ eoshift3 (gfc_array_char * const restrict ret,
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];
@ -65,6 +65,7 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type dim;
index_type len;
index_type n;
index_type size;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
@ -75,6 +76,8 @@ eoshift3 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
which = *pwhich - 1;
else
@ -89,13 +92,18 @@ eoshift3 (gfc_array_char * const restrict ret,
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
@ -112,24 +120,24 @@ eoshift3 (gfc_array_char * const restrict ret,
{
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++;
@ -260,8 +268,7 @@ eoshift3_4 (gfc_array_char * const restrict ret,
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);
}
@ -281,10 +288,10 @@ eoshift3_4_char (gfc_array_char * const restrict ret,
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);
}
@ -304,11 +311,11 @@ eoshift3_4_char4 (gfc_array_char * const restrict ret,
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));
}

45
libgfortran/generated/eoshift3_8.c
View File

@ -37,7 +37,7 @@ eoshift3 (gfc_array_char * const restrict ret,
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];
@ -65,6 +65,7 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type dim;
index_type len;
index_type n;
index_type size;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
@ -75,6 +76,8 @@ eoshift3 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
which = *pwhich - 1;
else
@ -89,13 +92,18 @@ eoshift3 (gfc_array_char * const restrict ret,
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
@ -112,24 +120,24 @@ eoshift3 (gfc_array_char * const restrict ret,
{
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++;
@ -260,8 +268,7 @@ eoshift3_8 (gfc_array_char * const restrict ret,
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);
}
@ -281,10 +288,10 @@ eoshift3_8_char (gfc_array_char * const restrict ret,
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);
}
@ -304,11 +311,11 @@ eoshift3_8_char4 (gfc_array_char * const restrict ret,
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));
}

4
libgfortran/generated/in_pack_c10.c
View File

@ -57,8 +57,8 @@ internal_pack_c10 (gfc_array_c10 * source)
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. */

4
libgfortran/generated/in_pack_c16.c
View File

@ -57,8 +57,8 @@ internal_pack_c16 (gfc_array_c16 * source)
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. */

4
libgfortran/generated/in_pack_c4.c
View File

@ -57,8 +57,8 @@ internal_pack_c4 (gfc_array_c4 * source)
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. */

4
libgfortran/generated/in_pack_c8.c
View File

@ -57,8 +57,8 @@ internal_pack_c8 (gfc_array_c8 * source)
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. */

4
libgfortran/generated/in_pack_i1.c
View File

@ -57,8 +57,8 @@ internal_pack_1 (gfc_array_i1 * source)
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. */

4
libgfortran/generated/in_pack_i16.c
View File

@ -57,8 +57,8 @@ internal_pack_16 (gfc_array_i16 * source)
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. */

4
libgfortran/generated/in_pack_i2.c
View File

@ -57,8 +57,8 @@ internal_pack_2 (gfc_array_i2 * source)
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. */

4
libgfortran/generated/in_pack_i4.c
View File

@ -57,8 +57,8 @@ internal_pack_4 (gfc_array_i4 * source)
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. */

4
libgfortran/generated/in_pack_i8.c
View File

@ -57,8 +57,8 @@ internal_pack_8 (gfc_array_i8 * source)
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. */

4
libgfortran/generated/in_pack_r10.c
View File

@ -57,8 +57,8 @@ internal_pack_r10 (gfc_array_r10 * source)
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. */

4
libgfortran/generated/in_pack_r16.c
View File

@ -57,8 +57,8 @@ internal_pack_r16 (gfc_array_r16 * source)
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. */

4
libgfortran/generated/in_pack_r4.c
View File

@ -57,8 +57,8 @@ internal_pack_r4 (gfc_array_r4 * source)
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. */

4
libgfortran/generated/in_pack_r8.c
View File

@ -57,8 +57,8 @@ internal_pack_r8 (gfc_array_r8 * source)
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. */

4
libgfortran/generated/in_unpack_c10.c
View File

@ -52,8 +52,8 @@ internal_unpack_c10 (gfc_array_c10 * d, const GFC_COMPLEX_10 * src)
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;

4
libgfortran/generated/in_unpack_c16.c
View File

@ -52,8 +52,8 @@ internal_unpack_c16 (gfc_array_c16 * d, const GFC_COMPLEX_16 * src)
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;

4
libgfortran/generated/in_unpack_c4.c
View File

@ -52,8 +52,8 @@ internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src)
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;

4
libgfortran/generated/in_unpack_c8.c
View File

@ -52,8 +52,8 @@ internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src)
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;

4
libgfortran/generated/in_unpack_i1.c
View File

@ -52,8 +52,8 @@ internal_unpack_1 (gfc_array_i1 * d, const GFC_INTEGER_1 * src)
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;

4
libgfortran/generated/in_unpack_i16.c
View File

@ -52,8 +52,8 @@ internal_unpack_16 (gfc_array_i16 * d, const GFC_INTEGER_16 * src)
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;

4
libgfortran/generated/in_unpack_i2.c
View File

@ -52,8 +52,8 @@ internal_unpack_2 (gfc_array_i2 * d, const GFC_INTEGER_2 * src)
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;

4
libgfortran/generated/in_unpack_i4.c
View File

@ -52,8 +52,8 @@ internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src)
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;

4
libgfortran/generated/in_unpack_i8.c
View File

@ -52,8 +52,8 @@ internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
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;

4
libgfortran/generated/in_unpack_r10.c
View File

@ -52,8 +52,8 @@ internal_unpack_r10 (gfc_array_r10 * d, const GFC_REAL_10 * src)
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;

4
libgfortran/generated/in_unpack_r16.c
View File

@ -52,8 +52,8 @@ internal_unpack_r16 (gfc_array_r16 * d, const GFC_REAL_16 * src)
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;

4
libgfortran/generated/in_unpack_r4.c
View File

@ -52,8 +52,8 @@ internal_unpack_r4 (gfc_array_r4 * d, const GFC_REAL_4 * src)
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;

4
libgfortran/generated/in_unpack_r8.c
View File

@ -52,8 +52,8 @@ internal_unpack_r8 (gfc_array_r8 * d, const GFC_REAL_8 * src)
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;

67
libgfortran/generated/matmul_c10.c
View File

@ -105,25 +105,22 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_c16.c
View File

@ -105,25 +105,22 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_c4.c
View File

@ -105,25 +105,22 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_c8.c
View File

@ -105,25 +105,22 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_i1.c
View File

@ -105,25 +105,22 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_i16.c
View File

@ -105,25 +105,22 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_i2.c
View File

@ -105,25 +105,22 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_i4.c
View File

@ -105,25 +105,22 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_i8.c
View File

@ -105,25 +105,22 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
}
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;

69
libgfortran/generated/matmul_l16.c
View File

@ -69,25 +69,22 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
{
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
@ -100,8 +97,8 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
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",
@ -109,8 +106,8 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
}
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",
@ -118,16 +115,16 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
}
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:"
@ -165,46 +162,46 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
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++)

69
libgfortran/generated/matmul_l4.c
View File

@ -69,25 +69,22 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
{
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
@ -100,8 +97,8 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
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",
@ -109,8 +106,8 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
}
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",
@ -118,16 +115,16 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
}
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:"
@ -165,46 +162,46 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
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++)

69
libgfortran/generated/matmul_l8.c
View File

@ -69,25 +69,22 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
{
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
@ -100,8 +97,8 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
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",
@ -109,8 +106,8 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
}
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",
@ -118,16 +115,16 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
}
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:"
@ -165,46 +162,46 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
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++)

67
libgfortran/generated/matmul_r10.c
View File

@ -105,25 +105,22 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_r16.c
View File

@ -105,25 +105,22 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_r4.c
View File

@ -105,25 +105,22 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
}
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;

67
libgfortran/generated/matmul_r8.c
View File

@ -105,25 +105,22 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
{
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
@ -136,8 +133,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
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",
@ -145,8 +142,8 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
}
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",
@ -154,16 +151,16 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
}
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:"
@ -178,43 +175,43 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
/* One-dimensional result may be addressed in the code below
either as a row or a column matrix. We want both cases to
work. */
rxstride = rystride = 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
@ -224,9 +221,9 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
}
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;

38
libgfortran/generated/maxloc0_16_i1.c
View File

@ -55,9 +55,7 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_i16.c
View File

@ -55,9 +55,7 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_i2.c
View File

@ -55,9 +55,7 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_i4.c
View File

@ -55,9 +55,7 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_i8.c
View File

@ -55,9 +55,7 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_r10.c
View File

@ -55,9 +55,7 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_r16.c
View File

@ -55,9 +55,7 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_r4.c
View File

@ -55,9 +55,7 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_16_r8.c
View File

@ -55,9 +55,7 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_i1.c
View File

@ -55,9 +55,7 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_i16.c
View File

@ -55,9 +55,7 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_i2.c
View File

@ -55,9 +55,7 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_i4.c
View File

@ -55,9 +55,7 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_i8.c
View File

@ -55,9 +55,7 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_r10.c
View File

@ -55,9 +55,7 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_r16.c
View File

@ -55,9 +55,7 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_r4.c
View File

@ -55,9 +55,7 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_4_r8.c
View File

@ -55,9 +55,7 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_8_i1.c
View File

@ -55,9 +55,7 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
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 ;

38
libgfortran/generated/maxloc0_8_i16.c
View File

@ -55,9 +55,7 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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);
@ -74,7 +72,7 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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",
@ -82,12 +80,12 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
}
}
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)
{
@ -179,9 +177,7 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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);
@ -200,7 +196,7 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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",
@ -214,8 +210,8 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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:"
@ -238,13 +234,13 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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)
{
@ -339,9 +335,7 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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);
@ -358,13 +352,13 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
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 ;

Some files were not shown because too many files have changed in this diff Show More