]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/generated/eoshift1_8.c
eoshift1.m4: Initialize variables to avoid warnings.
[thirdparty/gcc.git] / libgfortran / generated / eoshift1_8.c
CommitLineData
6de9cd9a 1/* Implementation of the EOSHIFT intrinsic
7672ae20 2 Copyright 2002, 2005 Free Software Foundation, Inc.
6de9cd9a
DN
3 Contributed by Paul Brook <paul@nowt.org>
4
57dea9f6 5This file is part of the GNU Fortran 95 runtime library (libgfortran).
6de9cd9a 6
57dea9f6
TM
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
6de9cd9a 9License as published by the Free Software Foundation; either
57dea9f6 10version 2 of the License, or (at your option) any later version.
6de9cd9a 11
57dea9f6
TM
12In addition to the permissions in the GNU General Public License, the
13Free Software Foundation gives you unlimited permission to link the
14compiled version of this file into combinations with other programs,
15and to distribute those combinations without any restriction coming
16from the use of this file. (The General Public License restrictions
17do apply in other respects; for example, they cover modification of
18the file, and distribution when not linked into a combine
19executable.)
20
21Libgfortran is distributed in the hope that it will be useful,
6de9cd9a
DN
22but WITHOUT ANY WARRANTY; without even the implied warranty of
23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
57dea9f6 24GNU General Public License for more details.
6de9cd9a 25
57dea9f6
TM
26You should have received a copy of the GNU General Public
27License along with libgfortran; see the file COPYING. If not,
6de9cd9a
DN
28write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29Boston, MA 02111-1307, USA. */
30
31#include "config.h"
32#include <stdlib.h>
33#include <assert.h>
34#include <string.h>
35#include "libgfortran.h"
36
37static const char zeros[16] =
38 {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
39
7f68c75f 40extern void eoshift1_8 (const gfc_array_char *,
7d7b8bfe
RH
41 const gfc_array_char *,
42 const gfc_array_i8 *, const char *,
43 const GFC_INTEGER_8 *);
7f68c75f 44export_proto(eoshift1_8);
7d7b8bfe 45
6de9cd9a 46void
7f68c75f
RH
47eoshift1_8 (const gfc_array_char *ret,
48 const gfc_array_char *array,
49 const gfc_array_i8 *h, const char *pbound,
50 const GFC_INTEGER_8 *pwhich)
6de9cd9a
DN
51{
52 /* r.* indicates the return array. */
e33e218b 53 index_type rstride[GFC_MAX_DIMENSIONS];
6de9cd9a
DN
54 index_type rstride0;
55 index_type roffset;
56 char *rptr;
57 char *dest;
58 /* s.* indicates the source array. */
e33e218b 59 index_type sstride[GFC_MAX_DIMENSIONS];
6de9cd9a
DN
60 index_type sstride0;
61 index_type soffset;
62 const char *sptr;
63 const char *src;
64 /* h.* indicates the shift array. */
e33e218b 65 index_type hstride[GFC_MAX_DIMENSIONS];
6de9cd9a
DN
66 index_type hstride0;
67 const GFC_INTEGER_8 *hptr;
68
e33e218b
TK
69 index_type count[GFC_MAX_DIMENSIONS];
70 index_type extent[GFC_MAX_DIMENSIONS];
6de9cd9a
DN
71 index_type dim;
72 index_type size;
73 index_type len;
74 index_type n;
75 int which;
76 GFC_INTEGER_8 sh;
77 GFC_INTEGER_8 delta;
78
7672ae20
AJ
79 /* The compiler cannot figure out that these are set, initialize
80 them to avoid warnings. */
81 len = 0;
82 soffset = 0;
83 roffset = 0;
84
6de9cd9a
DN
85 if (pwhich)
86 which = *pwhich - 1;
87 else
88 which = 0;
89
90 if (!pbound)
91 pbound = zeros;
92
93 size = GFC_DESCRIPTOR_SIZE (ret);
94
95 extent[0] = 1;
96 count[0] = 0;
97 size = GFC_DESCRIPTOR_SIZE (array);
98 n = 0;
99 for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
100 {
101 if (dim == which)
102 {
103 roffset = ret->dim[dim].stride * size;
104 if (roffset == 0)
105 roffset = size;
106 soffset = array->dim[dim].stride * size;
107 if (soffset == 0)
108 soffset = size;
109 len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
110 }
111 else
112 {
113 count[n] = 0;
114 extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
115 rstride[n] = ret->dim[dim].stride * size;
116 sstride[n] = array->dim[dim].stride * size;
117
118 hstride[n] = h->dim[n].stride;
119 n++;
120 }
121 }
122 if (sstride[0] == 0)
123 sstride[0] = size;
124 if (rstride[0] == 0)
125 rstride[0] = size;
126 if (hstride[0] == 0)
127 hstride[0] = 1;
128
129 dim = GFC_DESCRIPTOR_RANK (array);
130 rstride0 = rstride[0];
131 sstride0 = sstride[0];
132 hstride0 = hstride[0];
133 rptr = ret->data;
134 sptr = array->data;
135 hptr = h->data;
136
137 while (rptr)
138 {
139 /* Do the shift for this dimension. */
140 sh = *hptr;
141 delta = (sh >= 0) ? sh: -sh;
142 if (sh > 0)
143 {
144 src = &sptr[delta * soffset];
145 dest = rptr;
146 }
147 else
148 {
149 src = sptr;
150 dest = &rptr[delta * roffset];
151 }
152 for (n = 0; n < len - delta; n++)
153 {
154 memcpy (dest, src, size);
155 dest += roffset;
156 src += soffset;
157 }
158 if (sh < 0)
159 dest = rptr;
160 n = delta;
161
162 while (n--)
163 {
164 memcpy (dest, pbound, size);
165 dest += roffset;
166 }
167
168 /* Advance to the next section. */
169 rptr += rstride0;
170 sptr += sstride0;
171 hptr += hstride0;
172 count[0]++;
173 n = 0;
174 while (count[n] == extent[n])
175 {
176 /* When we get to the end of a dimension, reset it and increment
177 the next dimension. */
178 count[n] = 0;
179 /* We could precalculate these products, but this is a less
180 frequently used path so proabably not worth it. */
181 rptr -= rstride[n] * extent[n];
182 sptr -= sstride[n] * extent[n];
183 hptr -= hstride[n] * extent[n];
184 n++;
185 if (n >= dim - 1)
186 {
187 /* Break out of the loop. */
188 rptr = NULL;
189 break;
190 }
191 else
192 {
193 count[n]++;
194 rptr += rstride[n];
195 sptr += sstride[n];
196 hptr += hstride[n];
197 }
198 }
199 }
200}