1 dnl Support macro file for intrinsic functions.
2 dnl Contains the generic sections of the array functions.
3 dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
4 dnl Distributed under the GNU LGPL. See COPYING for details.
6 dnl Pass the implementation for a single section as the parameter to
7 dnl {MASK_}ARRAY_FUNCTION.
8 dnl The variables base, delta, and len describe the input section.
9 dnl For masked section the mask is described by mbase and mdelta.
10 dnl These should not be modified. The result should be stored in *dest.
11 dnl The names count, extent, sstride, dstride, base, dest, rank, dim
12 dnl retarray, array, pdim and mstride should not be used.
13 dnl The variable n is declared as index_type and may be used.
14 dnl Other variable declarations may be placed at the start of the code,
15 dnl The types of the array parameter and the return value are
16 dnl type_name and rtype_name respectively.
17 dnl Execution should be allowed to continue to the end of the block.
18 dnl You should not return or break from the inner loop of the implementation.
19 dnl Care should also be taken to avoid using the names defined in iparm.m4
20 define(START_ARRAY_FUNCTION,
22 `__'name`'rtype_qual`_'type_code (rtype * retarray, atype *array, index_type *pdim)
24 index_type count[GFC_MAX_DIMENSIONS - 1];
25 index_type extent[GFC_MAX_DIMENSIONS - 1];
26 index_type sstride[GFC_MAX_DIMENSIONS - 1];
27 index_type dstride[GFC_MAX_DIMENSIONS - 1];
36 /* Make dim zero based to avoid confusion. */
38 rank = GFC_DESCRIPTOR_RANK (array) - 1;
39 assert (rank == GFC_DESCRIPTOR_RANK (retarray));
40 if (array->dim[0].stride == 0)
41 array->dim[0].stride = 1;
42 if (retarray->dim[0].stride == 0)
43 retarray->dim[0].stride = 1;
45 len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
46 delta = array->dim[dim].stride;
48 for (n = 0; n < dim; n++)
50 sstride[n] = array->dim[n].stride;
51 extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
53 for (n = dim; n < rank; n++)
55 sstride[n] = array->dim[n + 1].stride;
57 array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
60 for (n = 0; n < rank; n++)
63 dstride[n] = retarray->dim[n].stride;
69 dest = retarray->data;
78 define(START_ARRAY_BLOCK,
83 for (n = 0; n < len; n++, src += delta)
86 define(FINISH_ARRAY_FUNCTION,
91 /* Advance to the next element. */
96 while (count[n] == extent[n])
98 /* When we get to the end of a dimension, reset it and increment
99 the next dimension. */
101 /* We could precalculate these products, but this is a less
102 frequently used path so proabably not worth it. */
103 base -= sstride[n] * extent[n];
104 dest -= dstride[n] * extent[n];
108 /* Break out of the look. */
121 define(START_MASKED_ARRAY_FUNCTION,
123 `__m'name`'rtype_qual`_'type_code (rtype * retarray, atype * array, index_type *pdim, gfc_array_l4 * mask)
125 index_type count[GFC_MAX_DIMENSIONS - 1];
126 index_type extent[GFC_MAX_DIMENSIONS - 1];
127 index_type sstride[GFC_MAX_DIMENSIONS - 1];
128 index_type dstride[GFC_MAX_DIMENSIONS - 1];
129 index_type mstride[GFC_MAX_DIMENSIONS - 1];
132 GFC_LOGICAL_4 *mbase;
141 rank = GFC_DESCRIPTOR_RANK (array) - 1;
142 assert (rank == GFC_DESCRIPTOR_RANK (retarray));
143 if (array->dim[0].stride == 0)
144 array->dim[0].stride = 1;
145 if (retarray->dim[0].stride == 0)
146 retarray->dim[0].stride = 1;
148 len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
151 delta = array->dim[dim].stride;
152 mdelta = mask->dim[dim].stride;
154 for (n = 0; n < dim; n++)
156 sstride[n] = array->dim[n].stride;
157 mstride[n] = mask->dim[n].stride;
158 extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
160 for (n = dim; n < rank; n++)
162 sstride[n] = array->dim[n + 1].stride;
163 mstride[n] = mask->dim[n + 1].stride;
165 array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
168 for (n = 0; n < rank; n++)
171 dstride[n] = retarray->dim[n].stride;
176 dest = retarray->data;
180 if (GFC_DESCRIPTOR_SIZE (mask) != 4)
182 /* This allows the same loop to be used for all logical types. */
183 assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
184 for (n = 0; n < rank; n++)
187 mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
199 define(START_MASKED_ARRAY_BLOCK,
204 for (n = 0; n < len; n++, src += delta, msrc += mdelta)
207 define(FINISH_MASKED_ARRAY_FUNCTION,
212 /* Advance to the next element. */
218 while (count[n] == extent[n])
220 /* When we get to the end of a dimension, reset it and increment
221 the next dimension. */
223 /* We could precalculate these products, but this is a less
224 frequently used path so proabably not worth it. */
225 base -= sstride[n] * extent[n];
226 mbase -= mstride[n] * extent[n];
227 dest -= dstride[n] * extent[n];
231 /* Break out of the look. */
245 define(ARRAY_FUNCTION,
246 `START_ARRAY_FUNCTION
248 START_ARRAY_BLOCK($1)
250 FINISH_ARRAY_FUNCTION')dnl
251 define(MASKED_ARRAY_FUNCTION,
252 `START_MASKED_ARRAY_FUNCTION
254 START_MASKED_ARRAY_BLOCK($1)
256 FINISH_MASKED_ARRAY_FUNCTION')dnl