1 /* Helper function for cshift functions. 2 Copyright (C) 2008-2024 Free Software Foundation, Inc. 3 Contributed by Thomas Koenig <tkoenig (at) 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 30 #if defined (HAVE_GFC_COMPLEX_10) 31 32 void 33 cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ptrdiff_t shift, 34 int which) 35 { 36 /* r.* indicates the return array. */ 37 index_type rstride[GFC_MAX_DIMENSIONS]; 38 index_type rstride0; 39 index_type roffset; 40 GFC_COMPLEX_10 *rptr; 41 42 /* s.* indicates the source array. */ 43 index_type sstride[GFC_MAX_DIMENSIONS]; 44 index_type sstride0; 45 index_type soffset; 46 const GFC_COMPLEX_10 *sptr; 47 48 index_type count[GFC_MAX_DIMENSIONS]; 49 index_type extent[GFC_MAX_DIMENSIONS]; 50 index_type dim; 51 index_type len; 52 index_type n; 53 54 bool do_blocked; 55 index_type r_ex, a_ex; 56 57 which = which - 1; 58 sstride[0] = 0; 59 rstride[0] = 0; 60 61 extent[0] = 1; 62 count[0] = 0; 63 n = 0; 64 /* Initialized for avoiding compiler warnings. */ 65 roffset = 1; 66 soffset = 1; 67 len = 0; 68 69 r_ex = 1; 70 a_ex = 1; 71 72 if (which > 0) 73 { 74 /* Test if both ret and array are contiguous. */ 75 do_blocked = true; 76 dim = GFC_DESCRIPTOR_RANK (array); 77 for (n = 0; n < dim; n ++) 78 { 79 index_type rs, as; 80 rs = GFC_DESCRIPTOR_STRIDE (ret, n); 81 if (rs != r_ex) 82 { 83 do_blocked = false; 84 break; 85 } 86 as = GFC_DESCRIPTOR_STRIDE (array, n); 87 if (as != a_ex) 88 { 89 do_blocked = false; 90 break; 91 } 92 r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n); 93 a_ex *= GFC_DESCRIPTOR_EXTENT (array, n); 94 } 95 } 96 else 97 do_blocked = false; 98 99 n = 0; 100 101 if (do_blocked) 102 { 103 /* For contiguous arrays, use the relationship that 104 105 dimension(n1,n2,n3) :: a, b 106 b = cshift(a,sh,3) 107 108 can be dealt with as if 109 110 dimension(n1*n2*n3) :: an, bn 111 bn = cshift(a,sh*n1*n2,1) 112 113 we can used a more blocked algorithm for dim>1. */ 114 sstride[0] = 1; 115 rstride[0] = 1; 116 roffset = 1; 117 soffset = 1; 118 len = GFC_DESCRIPTOR_STRIDE(array, which) 119 * GFC_DESCRIPTOR_EXTENT(array, which); 120 shift *= GFC_DESCRIPTOR_STRIDE(array, which); 121 for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++) 122 { 123 count[n] = 0; 124 extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); 125 rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); 126 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); 127 n++; 128 } 129 dim = GFC_DESCRIPTOR_RANK (array) - which; 130 } 131 else 132 { 133 for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) 134 { 135 if (dim == which) 136 { 137 roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); 138 if (roffset == 0) 139 roffset = 1; 140 soffset = GFC_DESCRIPTOR_STRIDE(array,dim); 141 if (soffset == 0) 142 soffset = 1; 143 len = GFC_DESCRIPTOR_EXTENT(array,dim); 144 } 145 else 146 { 147 count[n] = 0; 148 extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); 149 rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); 150 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); 151 n++; 152 } 153 } 154 if (sstride[0] == 0) 155 sstride[0] = 1; 156 if (rstride[0] == 0) 157 rstride[0] = 1; 158 159 dim = GFC_DESCRIPTOR_RANK (array); 160 } 161 162 rstride0 = rstride[0]; 163 sstride0 = sstride[0]; 164 rptr = ret->base_addr; 165 sptr = array->base_addr; 166 167 /* Avoid the costly modulo for trivially in-bound shifts. */ 168 if (shift < 0 || shift >= len) 169 { 170 shift = len == 0 ? 0 : shift % (ptrdiff_t)len; 171 if (shift < 0) 172 shift += len; 173 } 174 175 while (rptr) 176 { 177 /* Do the shift for this dimension. */ 178 179 /* If elements are contiguous, perform the operation 180 in two block moves. */ 181 if (soffset == 1 && roffset == 1) 182 { 183 size_t len1 = shift * sizeof (GFC_COMPLEX_10); 184 size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_10); 185 memcpy (rptr, sptr + shift, len2); 186 memcpy (rptr + (len - shift), sptr, len1); 187 } 188 else 189 { 190 /* Otherwise, we will have to perform the copy one element at 191 a time. */ 192 GFC_COMPLEX_10 *dest = rptr; 193 const GFC_COMPLEX_10 *src = &sptr[shift * soffset]; 194 195 for (n = 0; n < len - shift; n++) 196 { 197 *dest = *src; 198 dest += roffset; 199 src += soffset; 200 } 201 for (src = sptr, n = 0; n < shift; n++) 202 { 203 *dest = *src; 204 dest += roffset; 205 src += soffset; 206 } 207 } 208 209 /* Advance to the next section. */ 210 rptr += rstride0; 211 sptr += sstride0; 212 count[0]++; 213 n = 0; 214 while (count[n] == extent[n]) 215 { 216 /* When we get to the end of a dimension, reset it and increment 217 the next dimension. */ 218 count[n] = 0; 219 /* We could precalculate these products, but this is a less 220 frequently used path so probably not worth it. */ 221 rptr -= rstride[n] * extent[n]; 222 sptr -= sstride[n] * extent[n]; 223 n++; 224 if (n >= dim - 1) 225 { 226 /* Break out of the loop. */ 227 rptr = NULL; 228 break; 229 } 230 else 231 { 232 count[n]++; 233 rptr += rstride[n]; 234 sptr += sstride[n]; 235 } 236 } 237 } 238 239 return; 240 } 241 242 #endif 243
Indexes created Sat Feb 28 05:31:39 UTC 2026