OSDN Git Service

2397036ba72d06978435c35f26df99de4b2151d0
[pf3gnuchains/gcc-fork.git] / libgfortran / m4 / iforeach.m4
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.
5 define(START_FOREACH_FUNCTION,
6 `void
7 `__'name`'rtype_qual`_'type_code (rtype * retarray, atype *array)
8 {
9   index_type count[GFC_MAX_DIMENSIONS];
10   index_type extent[GFC_MAX_DIMENSIONS];
11   index_type sstride[GFC_MAX_DIMENSIONS];
12   index_type dstride;
13   type_name *base;
14   rtype_name *dest;
15   index_type rank;
16   index_type n;
17
18   rank = GFC_DESCRIPTOR_RANK (array);
19   assert (rank > 0);
20   assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
21   assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
22   if (array->dim[0].stride == 0)
23     array->dim[0].stride = 1;
24   if (retarray->dim[0].stride == 0)
25     retarray->dim[0].stride = 1;
26
27   dstride = retarray->dim[0].stride;
28   dest = retarray->data;
29   for (n = 0; n < rank; n++)
30     {
31       sstride[n] = array->dim[n].stride;
32       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
33       count[n] = 0;
34       if (extent[n] <= 0)
35         {
36           /* Set the return value.  */
37           for (n = 0; n < rank; n++)
38             dest[n * dstride] = 0;
39           return;
40         }
41     }
42
43   base = array->data;
44
45   /* Initialize the return value.  */
46   for (n = 0; n < rank; n++)
47     dest[n * dstride] = 1;
48   {
49 ')dnl
50 define(START_FOREACH_BLOCK,
51 `  while (base)
52     {
53       {
54         /* Implementation start.  */
55 ')dnl
56 define(FINISH_FOREACH_FUNCTION,
57 `        /* Implementation end.  */
58       }
59       /* Advance to the next element.  */
60       count[0]++;
61       base += sstride[0];
62       n = 0;
63       while (count[n] == extent[n])
64         {
65           /* When we get to the end of a dimension, reset it and increment
66              the next dimension.  */
67           count[n] = 0;
68           /* We could precalculate these products, but this is a less
69              frequently used path so proabably not worth it.  */
70           base -= sstride[n] * extent[n];
71           n++;
72           if (n == rank)
73             {
74               /* Break out of the loop.  */
75               base = NULL;
76               break;
77             }
78           else
79             {
80               count[n]++;
81               base += sstride[n];
82             }
83         }
84     }
85   }
86 }')dnl
87 define(START_MASKED_FOREACH_FUNCTION,
88 `void
89 `__m'name`'rtype_qual`_'type_code (rtype * retarray, atype *array, gfc_array_l4 * mask)
90 {
91   index_type count[GFC_MAX_DIMENSIONS];
92   index_type extent[GFC_MAX_DIMENSIONS];
93   index_type sstride[GFC_MAX_DIMENSIONS];
94   index_type mstride[GFC_MAX_DIMENSIONS];
95   index_type dstride;
96   rtype_name *dest;
97   type_name *base;
98   GFC_LOGICAL_4 *mbase;
99   int rank;
100   index_type n;
101
102   rank = GFC_DESCRIPTOR_RANK (array);
103   assert (rank > 0);
104   assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
105   assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
106   assert (GFC_DESCRIPTOR_RANK (mask) == rank);
107
108   if (array->dim[0].stride == 0)
109     array->dim[0].stride = 1;
110   if (retarray->dim[0].stride == 0)
111     retarray->dim[0].stride = 1;
112   if (retarray->dim[0].stride == 0)
113     retarray->dim[0].stride = 1;
114
115   dstride = retarray->dim[0].stride;
116   dest = retarray->data;
117   for (n = 0; n < rank; n++)
118     {
119       sstride[n] = array->dim[n].stride;
120       mstride[n] = mask->dim[n].stride;
121       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
122       count[n] = 0;
123       if (extent[n] <= 0)
124         {
125           /* Set the return value.  */
126           for (n = 0; n < rank; n++)
127             dest[n * dstride] = 0;
128           return;
129         }
130     }
131
132   base = array->data;
133   mbase = mask->data;
134
135   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
136     {
137       /* This allows the same loop to be used for all logical types.  */
138       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
139       for (n = 0; n < rank; n++)
140         mstride[n] <<= 1;
141       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
142     }
143
144
145   /* Initialize the return value.  */
146   for (n = 0; n < rank; n++)
147     dest[n * dstride] = 1;
148   {
149 ')dnl
150 define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
151 define(FINISH_MASKED_FOREACH_FUNCTION,
152 `        /* Implementation end.  */
153       }
154       /* Advance to the next element.  */
155       count[0]++;
156       base += sstride[0];
157       mbase += mstride[0];
158       n = 0;
159       while (count[n] == extent[n])
160         {
161           /* When we get to the end of a dimension, reset it and increment
162              the next dimension.  */
163           count[n] = 0;
164           /* We could precalculate these products, but this is a less
165              frequently used path so proabably not worth it.  */
166           base -= sstride[n] * extent[n];
167           mbase -= mstride[n] * extent[n];
168           n++;
169           if (n == rank)
170             {
171               /* Break out of the loop.  */
172               base = NULL;
173               break;
174             }
175           else
176             {
177               count[n]++;
178               base += sstride[n];
179               mbase += mstride[n];
180             }
181         }
182     }
183   }
184 }')dnl
185 define(FOREACH_FUNCTION,
186 `START_FOREACH_FUNCTION
187 $1
188 START_FOREACH_BLOCK
189 $2
190 FINISH_FOREACH_FUNCTION')dnl
191 define(MASKED_FOREACH_FUNCTION,
192 `START_MASKED_FOREACH_FUNCTION
193 $1
194 START_MASKED_FOREACH_BLOCK
195 $2
196 FINISH_MASKED_FOREACH_FUNCTION')dnl