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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [m4/] [eoshift3.m4] - Blame information for rev 733

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn
`/* 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
include(iparm.m4)dnl
32
 
33
`#if defined (HAVE_'atype_name`)
34
 
35
static void
36
eoshift3 (gfc_array_char * const restrict ret,
37
        const gfc_array_char * const restrict array,
38
        const 'atype` * const restrict h,
39
        const gfc_array_char * const restrict bound,
40
        const 'atype_name` * const restrict pwhich,
41
        const char * filler, index_type filler_len)
42
{
43
  /* r.* indicates the return array.  */
44
  index_type rstride[GFC_MAX_DIMENSIONS];
45
  index_type rstride0;
46
  index_type roffset;
47
  char *rptr;
48
  char * restrict dest;
49
  /* s.* indicates the source array.  */
50
  index_type sstride[GFC_MAX_DIMENSIONS];
51
  index_type sstride0;
52
  index_type soffset;
53
  const char *sptr;
54
  const char *src;
55
  /* h.* indicates the shift array.  */
56
  index_type hstride[GFC_MAX_DIMENSIONS];
57
  index_type hstride0;
58
  const 'atype_name` *hptr;
59
  /* b.* indicates the bound array.  */
60
  index_type bstride[GFC_MAX_DIMENSIONS];
61
  index_type bstride0;
62
  const char *bptr;
63
 
64
  index_type count[GFC_MAX_DIMENSIONS];
65
  index_type extent[GFC_MAX_DIMENSIONS];
66
  index_type dim;
67
  index_type len;
68
  index_type n;
69
  index_type size;
70
  index_type arraysize;
71
  int which;
72
  'atype_name` sh;
73
  'atype_name` delta;
74
 
75
  /* The compiler cannot figure out that these are set, initialize
76
     them to avoid warnings.  */
77
  len = 0;
78
  soffset = 0;
79
  roffset = 0;
80
 
81
  arraysize = size0 ((array_t *) array);
82
  size = GFC_DESCRIPTOR_SIZE(array);
83
 
84
  if (pwhich)
85
    which = *pwhich - 1;
86
  else
87
    which = 0;
88
 
89
  if (ret->data == NULL)
90
    {
91
      int i;
92
 
93
      ret->data = internal_malloc_size (size * arraysize);
94
      ret->offset = 0;
95
      ret->dtype = array->dtype;
96
      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
97
        {
98
          index_type ub, str;
99
 
100
          ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
101
 
102
          if (i == 0)
103
            str = 1;
104
          else
105
            str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
106
              * GFC_DESCRIPTOR_STRIDE(ret,i-1);
107
 
108
          GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
109
 
110
        }
111
      /* internal_malloc_size allocates a single byte for zero size.  */
112
      ret->data = internal_malloc_size (size * arraysize);
113
 
114
    }
115
  else if (unlikely (compile_options.bounds_check))
116
    {
117
      bounds_equal_extents ((array_t *) ret, (array_t *) array,
118
                                 "return value", "EOSHIFT");
119
    }
120
 
121
  if (unlikely (compile_options.bounds_check))
122
    {
123
      bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
124
                              "SHIFT argument", "EOSHIFT");
125
    }
126
 
127
  if (arraysize == 0)
128
    return;
129
 
130
  extent[0] = 1;
131
  count[0] = 0;
132
  n = 0;
133
  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
134
    {
135
      if (dim == which)
136
        {
137
          roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
138
          if (roffset == 0)
139
            roffset = size;
140
          soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
141
          if (soffset == 0)
142
            soffset = size;
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_BYTES(ret,dim);
150
          sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
151
 
152
          hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
153
          if (bound)
154
            bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
155
          else
156
            bstride[n] = 0;
157
          n++;
158
        }
159
    }
160
  if (sstride[0] == 0)
161
    sstride[0] = size;
162
  if (rstride[0] == 0)
163
    rstride[0] = size;
164
  if (hstride[0] == 0)
165
    hstride[0] = 1;
166
  if (bound && bstride[0] == 0)
167
    bstride[0] = size;
168
 
169
  dim = GFC_DESCRIPTOR_RANK (array);
170
  rstride0 = rstride[0];
171
  sstride0 = sstride[0];
172
  hstride0 = hstride[0];
173
  bstride0 = bstride[0];
174
  rptr = ret->data;
175
  sptr = array->data;
176
  hptr = h->data;
177
  if (bound)
178
    bptr = bound->data;
179
  else
180
    bptr = NULL;
181
 
182
  while (rptr)
183
    {
184
      /* Do the shift for this dimension.  */
185
      sh = *hptr;
186
      if (( sh >= 0 ? sh : -sh ) > len)
187
        {
188
          delta = len;
189
          sh = len;
190
        }
191
      else
192
        delta = (sh >= 0) ? sh: -sh;
193
 
194
      if (sh > 0)
195
        {
196
          src = &sptr[delta * soffset];
197
          dest = rptr;
198
        }
199
      else
200
        {
201
          src = sptr;
202
          dest = &rptr[delta * roffset];
203
        }
204
      for (n = 0; n < len - delta; n++)
205
        {
206
          memcpy (dest, src, size);
207
          dest += roffset;
208
          src += soffset;
209
        }
210
      if (sh < 0)
211
        dest = rptr;
212
      n = delta;
213
 
214
      if (bptr)
215
        while (n--)
216
          {
217
            memcpy (dest, bptr, size);
218
            dest += roffset;
219
          }
220
      else
221
        while (n--)
222
          {
223
            index_type i;
224
 
225
            if (filler_len == 1)
226
              memset (dest, filler[0], size);
227
            else
228
              for (i = 0; i < size; i += filler_len)
229
                memcpy (&dest[i], filler, filler_len);
230
 
231
            dest += roffset;
232
          }
233
 
234
      /* Advance to the next section.  */
235
      rptr += rstride0;
236
      sptr += sstride0;
237
      hptr += hstride0;
238
      bptr += bstride0;
239
      count[0]++;
240
      n = 0;
241
      while (count[n] == extent[n])
242
        {
243
          /* When we get to the end of a dimension, reset it and increment
244
             the next dimension.  */
245
          count[n] = 0;
246
          /* We could precalculate these products, but this is a less
247
             frequently used path so probably not worth it.  */
248
          rptr -= rstride[n] * extent[n];
249
          sptr -= sstride[n] * extent[n];
250
          hptr -= hstride[n] * extent[n];
251
          bptr -= bstride[n] * extent[n];
252
          n++;
253
          if (n >= dim - 1)
254
            {
255
              /* Break out of the loop.  */
256
              rptr = NULL;
257
              break;
258
            }
259
          else
260
            {
261
              count[n]++;
262
              rptr += rstride[n];
263
              sptr += sstride[n];
264
              hptr += hstride[n];
265
              bptr += bstride[n];
266
            }
267
        }
268
    }
269
}
270
 
271
extern void eoshift3_'atype_kind` (gfc_array_char * const restrict,
272
        const gfc_array_char * const restrict,
273
        const 'atype` * const restrict,
274
        const gfc_array_char * const restrict,
275
        const 'atype_name` *);
276
export_proto(eoshift3_'atype_kind`);
277
 
278
void
279
eoshift3_'atype_kind` (gfc_array_char * const restrict ret,
280
        const gfc_array_char * const restrict array,
281
        const 'atype` * const restrict h,
282
        const gfc_array_char * const restrict bound,
283
        const 'atype_name` * const restrict pwhich)
284
{
285
  eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
286
}
287
 
288
 
289
extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict,
290
        GFC_INTEGER_4,
291
        const gfc_array_char * const restrict,
292
        const 'atype` * const restrict,
293
        const gfc_array_char * const restrict,
294
        const 'atype_name` * const restrict,
295
        GFC_INTEGER_4, GFC_INTEGER_4);
296
export_proto(eoshift3_'atype_kind`_char);
297
 
298
void
299
eoshift3_'atype_kind`_char (gfc_array_char * const restrict ret,
300
        GFC_INTEGER_4 ret_length __attribute__((unused)),
301
        const gfc_array_char * const restrict array,
302
        const 'atype` *  const restrict h,
303
        const gfc_array_char * const restrict bound,
304
        const 'atype_name` * const restrict pwhich,
305
        GFC_INTEGER_4 array_length __attribute__((unused)),
306
        GFC_INTEGER_4 bound_length __attribute__((unused)))
307
{
308
  eoshift3 (ret, array, h, bound, pwhich, " ", 1);
309
}
310
 
311
 
312
extern void eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict,
313
        GFC_INTEGER_4,
314
        const gfc_array_char * const restrict,
315
        const 'atype` * const restrict,
316
        const gfc_array_char * const restrict,
317
        const 'atype_name` * const restrict,
318
        GFC_INTEGER_4, GFC_INTEGER_4);
319
export_proto(eoshift3_'atype_kind`_char4);
320
 
321
void
322
eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict ret,
323
        GFC_INTEGER_4 ret_length __attribute__((unused)),
324
        const gfc_array_char * const restrict array,
325
        const 'atype` *  const restrict h,
326
        const gfc_array_char * const restrict bound,
327
        const 'atype_name` * const restrict pwhich,
328
        GFC_INTEGER_4 array_length __attribute__((unused)),
329
        GFC_INTEGER_4 bound_length __attribute__((unused)))
330
{
331
  static const gfc_char4_t space = (unsigned char) ''` ''`;
332
  eoshift3 (ret, array, h, bound, pwhich,
333
            (const char *) &space, sizeof (gfc_char4_t));
334
}
335
 
336
#endif'

powered by: WebSVN 2.1.0

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