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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn
/* Helper function for cshift functions.
2
   Copyright 2008, 2009 Free Software Foundation, Inc.
3
   Contributed by Thomas Koenig <tkoenig@gcc.gnu.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
 
32
#if defined (HAVE_GFC_REAL_10)
33
 
34
void
35
cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ptrdiff_t shift,
36
                     int which)
37
{
38
  /* r.* indicates the return array.  */
39
  index_type rstride[GFC_MAX_DIMENSIONS];
40
  index_type rstride0;
41
  index_type roffset;
42
  GFC_REAL_10 *rptr;
43
 
44
  /* s.* indicates the source array.  */
45
  index_type sstride[GFC_MAX_DIMENSIONS];
46
  index_type sstride0;
47
  index_type soffset;
48
  const GFC_REAL_10 *sptr;
49
 
50
  index_type count[GFC_MAX_DIMENSIONS];
51
  index_type extent[GFC_MAX_DIMENSIONS];
52
  index_type dim;
53
  index_type len;
54
  index_type n;
55
 
56
  which = which - 1;
57
  sstride[0] = 0;
58
  rstride[0] = 0;
59
 
60
  extent[0] = 1;
61
  count[0] = 0;
62
  n = 0;
63
  /* Initialized for avoiding compiler warnings.  */
64
  roffset = 1;
65
  soffset = 1;
66
  len = 0;
67
 
68
  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
69
    {
70
      if (dim == which)
71
        {
72
          roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
73
          if (roffset == 0)
74
            roffset = 1;
75
          soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
76
          if (soffset == 0)
77
            soffset = 1;
78
          len = GFC_DESCRIPTOR_EXTENT(array,dim);
79
        }
80
      else
81
        {
82
          count[n] = 0;
83
          extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
84
          rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
85
          sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
86
          n++;
87
        }
88
    }
89
  if (sstride[0] == 0)
90
    sstride[0] = 1;
91
  if (rstride[0] == 0)
92
    rstride[0] = 1;
93
 
94
  dim = GFC_DESCRIPTOR_RANK (array);
95
  rstride0 = rstride[0];
96
  sstride0 = sstride[0];
97
  rptr = ret->data;
98
  sptr = array->data;
99
 
100
  shift = len == 0 ? 0 : shift % (ptrdiff_t)len;
101
  if (shift < 0)
102
    shift += len;
103
 
104
  while (rptr)
105
    {
106
      /* Do the shift for this dimension.  */
107
 
108
      /* If elements are contiguous, perform the operation
109
         in two block moves.  */
110
      if (soffset == 1 && roffset == 1)
111
        {
112
          size_t len1 = shift * sizeof (GFC_REAL_10);
113
          size_t len2 = (len - shift) * sizeof (GFC_REAL_10);
114
          memcpy (rptr, sptr + shift, len2);
115
          memcpy (rptr + (len - shift), sptr, len1);
116
        }
117
      else
118
        {
119
          /* Otherwise, we will have to perform the copy one element at
120
             a time.  */
121
          GFC_REAL_10 *dest = rptr;
122
          const GFC_REAL_10 *src = &sptr[shift * soffset];
123
 
124
          for (n = 0; n < len - shift; n++)
125
            {
126
              *dest = *src;
127
              dest += roffset;
128
              src += soffset;
129
            }
130
          for (src = sptr, n = 0; n < shift; n++)
131
            {
132
              *dest = *src;
133
              dest += roffset;
134
              src += soffset;
135
            }
136
        }
137
 
138
      /* Advance to the next section.  */
139
      rptr += rstride0;
140
      sptr += sstride0;
141
      count[0]++;
142
      n = 0;
143
      while (count[n] == extent[n])
144
        {
145
          /* When we get to the end of a dimension, reset it and increment
146
             the next dimension.  */
147
          count[n] = 0;
148
          /* We could precalculate these products, but this is a less
149
             frequently used path so probably not worth it.  */
150
          rptr -= rstride[n] * extent[n];
151
          sptr -= sstride[n] * extent[n];
152
          n++;
153
          if (n >= dim - 1)
154
            {
155
              /* Break out of the loop.  */
156
              rptr = NULL;
157
              break;
158
            }
159
          else
160
            {
161
              count[n]++;
162
              rptr += rstride[n];
163
              sptr += sstride[n];
164
            }
165
        }
166
    }
167
 
168
  return;
169
}
170
 
171
#endif

powered by: WebSVN 2.1.0

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