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 atype_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`_'atype_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 if (retarray->data == NULL)
62 for (n = 0; n < rank; n++)
64 retarray->dim[n].lbound = 0;
65 retarray->dim[n].ubound = extent[n]-1;
67 retarray->dim[n].stride = 1;
69 retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
72 retarray->data = internal_malloc (sizeof (rtype_name) *
73 (retarray->dim[rank-1].stride * extent[rank-1]));
77 for (n = 0; n < rank; n++)
80 dstride[n] = retarray->dim[n].stride;
86 dest = retarray->data;
95 define(START_ARRAY_BLOCK,
100 for (n = 0; n < len; n++, src += delta)
103 define(FINISH_ARRAY_FUNCTION,
108 /* Advance to the next element. */
113 while (count[n] == extent[n])
115 /* When we get to the end of a dimension, reset it and increment
116 the next dimension. */
118 /* We could precalculate these products, but this is a less
119 frequently used path so proabably not worth it. */
120 base -= sstride[n] * extent[n];
121 dest -= dstride[n] * extent[n];
125 /* Break out of the look. */
138 define(START_MASKED_ARRAY_FUNCTION,
140 `__m'name`'rtype_qual`_'atype_code (rtype * retarray, atype * array, index_type *pdim, gfc_array_l4 * mask)
142 index_type count[GFC_MAX_DIMENSIONS - 1];
143 index_type extent[GFC_MAX_DIMENSIONS - 1];
144 index_type sstride[GFC_MAX_DIMENSIONS - 1];
145 index_type dstride[GFC_MAX_DIMENSIONS - 1];
146 index_type mstride[GFC_MAX_DIMENSIONS - 1];
149 GFC_LOGICAL_4 *mbase;
158 rank = GFC_DESCRIPTOR_RANK (array) - 1;
159 assert (rank == GFC_DESCRIPTOR_RANK (retarray));
160 if (array->dim[0].stride == 0)
161 array->dim[0].stride = 1;
162 if (retarray->dim[0].stride == 0)
163 retarray->dim[0].stride = 1;
165 len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
168 delta = array->dim[dim].stride;
169 mdelta = mask->dim[dim].stride;
171 for (n = 0; n < dim; n++)
173 sstride[n] = array->dim[n].stride;
174 mstride[n] = mask->dim[n].stride;
175 extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
177 for (n = dim; n < rank; n++)
179 sstride[n] = array->dim[n + 1].stride;
180 mstride[n] = mask->dim[n + 1].stride;
182 array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
185 for (n = 0; n < rank; n++)
188 dstride[n] = retarray->dim[n].stride;
193 dest = retarray->data;
197 if (GFC_DESCRIPTOR_SIZE (mask) != 4)
199 /* This allows the same loop to be used for all logical types. */
200 assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
201 for (n = 0; n < rank; n++)
204 mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
216 define(START_MASKED_ARRAY_BLOCK,
221 for (n = 0; n < len; n++, src += delta, msrc += mdelta)
224 define(FINISH_MASKED_ARRAY_FUNCTION,
229 /* Advance to the next element. */
235 while (count[n] == extent[n])
237 /* When we get to the end of a dimension, reset it and increment
238 the next dimension. */
240 /* We could precalculate these products, but this is a less
241 frequently used path so proabably not worth it. */
242 base -= sstride[n] * extent[n];
243 mbase -= mstride[n] * extent[n];
244 dest -= dstride[n] * extent[n];
248 /* Break out of the look. */
262 define(ARRAY_FUNCTION,
263 `START_ARRAY_FUNCTION
265 START_ARRAY_BLOCK($1)
267 FINISH_ARRAY_FUNCTION')dnl
268 define(MASKED_ARRAY_FUNCTION,
269 `START_MASKED_ARRAY_FUNCTION
271 START_MASKED_ARRAY_BLOCK($1)
273 FINISH_MASKED_ARRAY_FUNCTION')dnl