OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [intrinsics/] [eoshift0.c] - Blame information for rev 733

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn
/* Generic implementation of the EOSHIFT intrinsic
2
   Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc.
3
   Contributed by Paul Brook <paul@nowt.org>
4
 
5
This file is part of the GNU Fortran 95 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 <stdlib.h>
28
#include <assert.h>
29
#include <string.h>
30
 
31
/* TODO: make this work for large shifts when
32
   sizeof(int) < sizeof (index_type).  */
33
 
34
static void
35
eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
36
          int shift, const char * pbound, int which, index_type size,
37
          const char *filler, index_type filler_len)
38
{
39
  /* r.* indicates the return array.  */
40
  index_type rstride[GFC_MAX_DIMENSIONS];
41
  index_type rstride0;
42
  index_type roffset;
43
  char * restrict rptr;
44
  char *dest;
45
  /* s.* indicates the source array.  */
46
  index_type sstride[GFC_MAX_DIMENSIONS];
47
  index_type sstride0;
48
  index_type soffset;
49
  const char *sptr;
50
  const char *src;
51
 
52
  index_type count[GFC_MAX_DIMENSIONS];
53
  index_type extent[GFC_MAX_DIMENSIONS];
54
  index_type dim;
55
  index_type len;
56
  index_type n;
57
  index_type arraysize;
58
 
59
  /* The compiler cannot figure out that these are set, initialize
60
     them to avoid warnings.  */
61
  len = 0;
62
  soffset = 0;
63
  roffset = 0;
64
 
65
  arraysize = size0 ((array_t *) array);
66
 
67
  if (ret->data == NULL)
68
    {
69
      int i;
70
 
71
      ret->offset = 0;
72
      ret->dtype = array->dtype;
73
      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
74
        {
75
          index_type ub, str;
76
 
77
          ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
78
 
79
          if (i == 0)
80
            str = 1;
81
          else
82
            str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
83
              * GFC_DESCRIPTOR_STRIDE(ret,i-1);
84
 
85
          GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
86
 
87
        }
88
 
89
      /* internal_malloc_size allocates a single byte for zero size.  */
90
      ret->data = internal_malloc_size (size * arraysize);
91
    }
92
  else if (unlikely (compile_options.bounds_check))
93
    {
94
      bounds_equal_extents ((array_t *) ret, (array_t *) array,
95
                                 "return value", "EOSHIFT");
96
    }
97
 
98
  if (arraysize == 0)
99
    return;
100
 
101
  which = which - 1;
102
 
103
  extent[0] = 1;
104
  count[0] = 0;
105
  sstride[0] = -1;
106
  rstride[0] = -1;
107
  n = 0;
108
  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
109
    {
110
      if (dim == which)
111
        {
112
          roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
113
          if (roffset == 0)
114
            roffset = size;
115
          soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
116
          if (soffset == 0)
117
            soffset = size;
118
          len = GFC_DESCRIPTOR_EXTENT(array,dim);
119
        }
120
      else
121
        {
122
          count[n] = 0;
123
          extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
124
          rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
125
          sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
126
          n++;
127
        }
128
    }
129
  if (sstride[0] == 0)
130
    sstride[0] = size;
131
  if (rstride[0] == 0)
132
    rstride[0] = size;
133
 
134
  dim = GFC_DESCRIPTOR_RANK (array);
135
  rstride0 = rstride[0];
136
  sstride0 = sstride[0];
137
  rptr = ret->data;
138
  sptr = array->data;
139
 
140
  if ((shift >= 0 ? shift : -shift) > len)
141
    {
142
      shift = len;
143
      len = 0;
144
    }
145
  else
146
    {
147
      if (shift > 0)
148
        len = len - shift;
149
      else
150
        len = len + shift;
151
    }
152
 
153
  while (rptr)
154
    {
155
      /* Do the shift for this dimension.  */
156
      if (shift > 0)
157
        {
158
          src = &sptr[shift * soffset];
159
          dest = rptr;
160
        }
161
      else
162
        {
163
          src = sptr;
164
          dest = &rptr[-shift * roffset];
165
        }
166
      for (n = 0; n < len; n++)
167
        {
168
          memcpy (dest, src, size);
169
          dest += roffset;
170
          src += soffset;
171
        }
172
      if (shift >= 0)
173
        {
174
          n = shift;
175
        }
176
      else
177
        {
178
          dest = rptr;
179
          n = -shift;
180
        }
181
 
182
      if (pbound)
183
        while (n--)
184
          {
185
            memcpy (dest, pbound, size);
186
            dest += roffset;
187
          }
188
      else
189
        while (n--)
190
          {
191
            index_type i;
192
 
193
            if (filler_len == 1)
194
              memset (dest, filler[0], size);
195
            else
196
              for (i = 0; i < size ; i += filler_len)
197
                memcpy (&dest[i], filler, filler_len);
198
 
199
            dest += roffset;
200
          }
201
 
202
      /* Advance to the next section.  */
203
      rptr += rstride0;
204
      sptr += sstride0;
205
      count[0]++;
206
      n = 0;
207
      while (count[n] == extent[n])
208
        {
209
          /* When we get to the end of a dimension, reset it and increment
210
             the next dimension.  */
211
          count[n] = 0;
212
          /* We could precalculate these products, but this is a less
213
             frequently used path so probably not worth it.  */
214
          rptr -= rstride[n] * extent[n];
215
          sptr -= sstride[n] * extent[n];
216
          n++;
217
          if (n >= dim - 1)
218
            {
219
              /* Break out of the loop.  */
220
              rptr = NULL;
221
              break;
222
            }
223
          else
224
            {
225
              count[n]++;
226
              rptr += rstride[n];
227
              sptr += sstride[n];
228
            }
229
        }
230
    }
231
}
232
 
233
 
234
#define DEFINE_EOSHIFT(N)                                                     \
235
  extern void eoshift0_##N (gfc_array_char *, const gfc_array_char *,         \
236
                            const GFC_INTEGER_##N *, const char *,            \
237
                            const GFC_INTEGER_##N *);                         \
238
  export_proto(eoshift0_##N);                                                 \
239
                                                                              \
240
  void                                                                        \
241
  eoshift0_##N (gfc_array_char *ret, const gfc_array_char *array,             \
242
                const GFC_INTEGER_##N *pshift, const char *pbound,            \
243
                const GFC_INTEGER_##N *pdim)                                  \
244
  {                                                                           \
245
    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,                  \
246
              GFC_DESCRIPTOR_SIZE (array), "\0", 1);                          \
247
  }                                                                           \
248
                                                                              \
249
  extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4,           \
250
                                   const gfc_array_char *,                    \
251
                                   const GFC_INTEGER_##N *, const char *,     \
252
                                   const GFC_INTEGER_##N *, GFC_INTEGER_4,    \
253
                                   GFC_INTEGER_4);                            \
254
  export_proto(eoshift0_##N##_char);                                          \
255
                                                                              \
256
  void                                                                        \
257
  eoshift0_##N##_char (gfc_array_char *ret,                                   \
258
                       GFC_INTEGER_4 ret_length __attribute__((unused)),      \
259
                       const gfc_array_char *array,                           \
260
                       const GFC_INTEGER_##N *pshift,                         \
261
                       const char *pbound,                                    \
262
                       const GFC_INTEGER_##N *pdim,                           \
263
                       GFC_INTEGER_4 array_length,                            \
264
                       GFC_INTEGER_4 bound_length __attribute__((unused)))    \
265
  {                                                                           \
266
    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,                  \
267
              array_length, " ", 1);                                          \
268
  }                                                                           \
269
                                                                              \
270
  extern void eoshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4,          \
271
                                    const gfc_array_char *,                   \
272
                                    const GFC_INTEGER_##N *, const char *,    \
273
                                    const GFC_INTEGER_##N *, GFC_INTEGER_4,   \
274
                                    GFC_INTEGER_4);                           \
275
  export_proto(eoshift0_##N##_char4);                                         \
276
                                                                              \
277
  void                                                                        \
278
  eoshift0_##N##_char4 (gfc_array_char *ret,                                  \
279
                        GFC_INTEGER_4 ret_length __attribute__((unused)),     \
280
                        const gfc_array_char *array,                          \
281
                        const GFC_INTEGER_##N *pshift,                        \
282
                        const char *pbound,                                   \
283
                        const GFC_INTEGER_##N *pdim,                          \
284
                        GFC_INTEGER_4 array_length,                           \
285
                        GFC_INTEGER_4 bound_length __attribute__((unused)))   \
286
  {                                                                           \
287
    static const gfc_char4_t space = (unsigned char) ' ';                     \
288
    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,                  \
289
              array_length * sizeof (gfc_char4_t), (const char *) &space,     \
290
              sizeof (gfc_char4_t));                                          \
291
  }
292
 
293
DEFINE_EOSHIFT (1);
294
DEFINE_EOSHIFT (2);
295
DEFINE_EOSHIFT (4);
296
DEFINE_EOSHIFT (8);
297
#ifdef HAVE_GFC_INTEGER_16
298
DEFINE_EOSHIFT (16);
299
#endif

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.