Mercurial > hg > CbC > CbC_gcc

comparison libgfortran/m4/cshift0.m4 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 `/* Helper function for cshift functions.
2 Copyright (C) 2008-2017 Free Software Foundation, Inc.
3 Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
4
5 This file is part of the GNU Fortran runtime library (libgfortran).
6
7 Libgfortran is free software; you can redistribute it and/or
8 modify it under the terms of the GNU General Public
9 License as published by the Free Software Foundation; either
10 version 3 of the License, or (at your option) any later version.
11
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
20
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
25
26 #include "libgfortran.h"
27 #include <string.h>'
28
29 include(iparm.m4)dnl
30
31 `#if defined (HAVE_'rtype_name`)
32
33 void
34 cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift,
35 int which)
36 {
37 /* r.* indicates the return array. */
38 index_type rstride[GFC_MAX_DIMENSIONS];
39 index_type rstride0;
40 index_type roffset;
41 'rtype_name` *rptr;
42
43 /* s.* indicates the source array. */
44 index_type sstride[GFC_MAX_DIMENSIONS];
45 index_type sstride0;
46 index_type soffset;
47 const 'rtype_name` *sptr;
48
49 index_type count[GFC_MAX_DIMENSIONS];
50 index_type extent[GFC_MAX_DIMENSIONS];
51 index_type dim;
52 index_type len;
53 index_type n;
54
55 bool do_blocked;
56 index_type r_ex, a_ex;
57
58 which = which - 1;
59 sstride[0] = 0;
60 rstride[0] = 0;
61
62 extent[0] = 1;
63 count[0] = 0;
64 n = 0;
65 /* Initialized for avoiding compiler warnings. */
66 roffset = 1;
67 soffset = 1;
68 len = 0;
69
70 r_ex = 1;
71 a_ex = 1;
72
73 if (which > 0)
74 {
75 /* Test if both ret and array are contiguous. */
76 do_blocked = true;
77 dim = GFC_DESCRIPTOR_RANK (array);
78 for (n = 0; n < dim; n ++)
79 {
80 index_type rs, as;
81 rs = GFC_DESCRIPTOR_STRIDE (ret, n);
82 if (rs != r_ex)
83 {
84 do_blocked = false;
85 break;
86 }
87 as = GFC_DESCRIPTOR_STRIDE (array, n);
88 if (as != a_ex)
89 {
90 do_blocked = false;
91 break;
92 }
93 r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
94 a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
95 }
96 }
97 else
98 do_blocked = false;
99
100 n = 0;
101
102 if (do_blocked)
103 {
104 /* For contiguous arrays, use the relationship that
105
106 dimension(n1,n2,n3) :: a, b
107 b = cshift(a,sh,3)
108
109 can be dealt with as if
110
111 dimension(n1*n2*n3) :: an, bn
112 bn = cshift(a,sh*n1*n2,1)
113
114 we can used a more blocked algorithm for dim>1. */
115 sstride[0] = 1;
116 rstride[0] = 1;
117 roffset = 1;
118 soffset = 1;
119 len = GFC_DESCRIPTOR_STRIDE(array, which)
120 * GFC_DESCRIPTOR_EXTENT(array, which);
121 shift *= GFC_DESCRIPTOR_STRIDE(array, which);
122 for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
123 {
124 count[n] = 0;
125 extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
126 rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
127 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
128 n++;
129 }
130 dim = GFC_DESCRIPTOR_RANK (array) - which;
131 }
132 else
133 {
134 for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
135 {
136 if (dim == which)
137 {
138 roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
139 if (roffset == 0)
140 roffset = 1;
141 soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
142 if (soffset == 0)
143 soffset = 1;
144 len = GFC_DESCRIPTOR_EXTENT(array,dim);
145 }
146 else
147 {
148 count[n] = 0;
149 extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
150 rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
151 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
152 n++;
153 }
154 }
155 if (sstride[0] == 0)
156 sstride[0] = 1;
157 if (rstride[0] == 0)
158 rstride[0] = 1;
159
160 dim = GFC_DESCRIPTOR_RANK (array);
161 }
162
163 rstride0 = rstride[0];
164 sstride0 = sstride[0];
165 rptr = ret->base_addr;
166 sptr = array->base_addr;
167
168 /* Avoid the costly modulo for trivially in-bound shifts. */
169 if (shift < 0 || shift >= len)
170 {
171 shift = len == 0 ? 0 : shift % (ptrdiff_t)len;
172 if (shift < 0)
173 shift += len;
174 }
175
176 while (rptr)
177 {
178 /* Do the shift for this dimension. */
179
180 /* If elements are contiguous, perform the operation
181 in two block moves. */
182 if (soffset == 1 && roffset == 1)
183 {
184 size_t len1 = shift * sizeof ('rtype_name`);
185 size_t len2 = (len - shift) * sizeof ('rtype_name`);
186 memcpy (rptr, sptr + shift, len2);
187 memcpy (rptr + (len - shift), sptr, len1);
188 }
189 else
190 {
191 /* Otherwise, we will have to perform the copy one element at
192 a time. */
193 'rtype_name` *dest = rptr;
194 const 'rtype_name` *src = &sptr[shift * soffset];
195
196 for (n = 0; n < len - shift; n++)
197 {
198 *dest = *src;
199 dest += roffset;
200 src += soffset;
201 }
202 for (src = sptr, n = 0; n < shift; n++)
203 {
204 *dest = *src;
205 dest += roffset;
206 src += soffset;
207 }
208 }
209
210 /* Advance to the next section. */
211 rptr += rstride0;
212 sptr += sstride0;
213 count[0]++;
214 n = 0;
215 while (count[n] == extent[n])
216 {
217 /* When we get to the end of a dimension, reset it and increment
218 the next dimension. */
219 count[n] = 0;
220 /* We could precalculate these products, but this is a less
221 frequently used path so probably not worth it. */
222 rptr -= rstride[n] * extent[n];
223 sptr -= sstride[n] * extent[n];
224 n++;
225 if (n >= dim - 1)
226 {
227 /* Break out of the loop. */
228 rptr = NULL;
229 break;
230 }
231 else
232 {
233 count[n]++;
234 rptr += rstride[n];
235 sptr += sstride[n];
236 }
237 }
238 }
239
240 return;
241 }
242
243 #endif'