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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [libgfortran/] [generated/] [reshape_i4.c] - Blame information for rev 14

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 14 jlechner
/* Implementation of the RESHAPE
2
   Copyright 2002 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 2 of the License, or (at your option) any later version.
11
 
12
In addition to the permissions in the GNU General Public License, the
13
Free Software Foundation gives you unlimited permission to link the
14
compiled version of this file into combinations with other programs,
15
and to distribute those combinations without any restriction coming
16
from the use of this file.  (The General Public License restrictions
17
do apply in other respects; for example, they cover modification of
18
the file, and distribution when not linked into a combine
19
executable.)
20
 
21
Libgfortran is distributed in the hope that it will be useful,
22
but WITHOUT ANY WARRANTY; without even the implied warranty of
23
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24
GNU General Public License for more details.
25
 
26
You should have received a copy of the GNU General Public
27
License along with libgfortran; see the file COPYING.  If not,
28
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29
Boston, MA 02110-1301, USA.  */
30
 
31
#include "config.h"
32
#include <stdlib.h>
33
#include <assert.h>
34
#include "libgfortran.h"
35
 
36
#if defined (HAVE_GFC_INTEGER_4)
37
 
38
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
39
 
40
/* The shape parameter is ignored. We can currently deduce the shape from the
41
   return array.  */
42
 
43
extern void reshape_4 (gfc_array_i4 *, gfc_array_i4 *, shape_type *,
44
                                    gfc_array_i4 *, shape_type *);
45
export_proto(reshape_4);
46
 
47
void
48
reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
49
                      gfc_array_i4 * pad, shape_type * order)
50
{
51
  /* r.* indicates the return array.  */
52
  index_type rcount[GFC_MAX_DIMENSIONS];
53
  index_type rextent[GFC_MAX_DIMENSIONS];
54
  index_type rstride[GFC_MAX_DIMENSIONS];
55
  index_type rstride0;
56
  index_type rdim;
57
  index_type rsize;
58
  index_type rs;
59
  index_type rex;
60
  GFC_INTEGER_4 *rptr;
61
  /* s.* indicates the source array.  */
62
  index_type scount[GFC_MAX_DIMENSIONS];
63
  index_type sextent[GFC_MAX_DIMENSIONS];
64
  index_type sstride[GFC_MAX_DIMENSIONS];
65
  index_type sstride0;
66
  index_type sdim;
67
  index_type ssize;
68
  const GFC_INTEGER_4 *sptr;
69
  /* p.* indicates the pad array.  */
70
  index_type pcount[GFC_MAX_DIMENSIONS];
71
  index_type pextent[GFC_MAX_DIMENSIONS];
72
  index_type pstride[GFC_MAX_DIMENSIONS];
73
  index_type pdim;
74
  index_type psize;
75
  const GFC_INTEGER_4 *pptr;
76
 
77
  const GFC_INTEGER_4 *src;
78
  int n;
79
  int dim;
80
 
81
  if (source->dim[0].stride == 0)
82
    source->dim[0].stride = 1;
83
  if (shape->dim[0].stride == 0)
84
    shape->dim[0].stride = 1;
85
  if (pad && pad->dim[0].stride == 0)
86
    pad->dim[0].stride = 1;
87
  if (order && order->dim[0].stride == 0)
88
    order->dim[0].stride = 1;
89
 
90
  if (ret->data == NULL)
91
    {
92
      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
93
      rs = 1;
94
      for (n=0; n < rdim; n++)
95
        {
96
          ret->dim[n].lbound = 0;
97
          rex = shape->data[n * shape->dim[0].stride];
98
          ret->dim[n].ubound =  rex - 1;
99
          ret->dim[n].stride = rs;
100
          rs *= rex;
101
        }
102
      ret->offset = 0;
103
      ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_4));
104
      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
105
    }
106
  else
107
    {
108
      rdim = GFC_DESCRIPTOR_RANK (ret);
109
      if (ret->dim[0].stride == 0)
110
        ret->dim[0].stride = 1;
111
    }
112
 
113
  rsize = 1;
114
  for (n = 0; n < rdim; n++)
115
    {
116
      if (order)
117
        dim = order->data[n * order->dim[0].stride] - 1;
118
      else
119
        dim = n;
120
 
121
      rcount[n] = 0;
122
      rstride[n] = ret->dim[dim].stride;
123
      rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
124
 
125
      if (rextent[n] != shape->data[dim * shape->dim[0].stride])
126
        runtime_error ("shape and target do not conform");
127
 
128
      if (rsize == rstride[n])
129
        rsize *= rextent[n];
130
      else
131
        rsize = 0;
132
      if (rextent[n] <= 0)
133
        return;
134
    }
135
 
136
  sdim = GFC_DESCRIPTOR_RANK (source);
137
  ssize = 1;
138
  for (n = 0; n < sdim; n++)
139
    {
140
      scount[n] = 0;
141
      sstride[n] = source->dim[n].stride;
142
      sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
143
      if (sextent[n] <= 0)
144
        abort ();
145
 
146
      if (ssize == sstride[n])
147
        ssize *= sextent[n];
148
      else
149
        ssize = 0;
150
    }
151
 
152
  if (pad)
153
    {
154
      pdim = GFC_DESCRIPTOR_RANK (pad);
155
      psize = 1;
156
      for (n = 0; n < pdim; n++)
157
        {
158
          pcount[n] = 0;
159
          pstride[n] = pad->dim[n].stride;
160
          pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
161
          if (pextent[n] <= 0)
162
            abort ();
163
          if (psize == pstride[n])
164
            psize *= pextent[n];
165
          else
166
            psize = 0;
167
        }
168
      pptr = pad->data;
169
    }
170
  else
171
    {
172
      pdim = 0;
173
      psize = 1;
174
      pptr = NULL;
175
    }
176
 
177
  if (rsize != 0 && ssize != 0 && psize != 0)
178
    {
179
      rsize *= sizeof (GFC_INTEGER_4);
180
      ssize *= sizeof (GFC_INTEGER_4);
181
      psize *= sizeof (GFC_INTEGER_4);
182
      reshape_packed ((char *)ret->data, rsize, (char *)source->data,
183
                      ssize, pad ? (char *)pad->data : NULL, psize);
184
      return;
185
    }
186
  rptr = ret->data;
187
  src = sptr = source->data;
188
  rstride0 = rstride[0];
189
  sstride0 = sstride[0];
190
 
191
  while (rptr)
192
    {
193
      /* Select between the source and pad arrays.  */
194
      *rptr = *src;
195
      /* Advance to the next element.  */
196
      rptr += rstride0;
197
      src += sstride0;
198
      rcount[0]++;
199
      scount[0]++;
200
      /* Advance to the next destination element.  */
201
      n = 0;
202
      while (rcount[n] == rextent[n])
203
        {
204
          /* When we get to the end of a dimension, reset it and increment
205
             the next dimension.  */
206
          rcount[n] = 0;
207
          /* We could precalculate these products, but this is a less
208
             frequently used path so proabably not worth it.  */
209
          rptr -= rstride[n] * rextent[n];
210
          n++;
211
          if (n == rdim)
212
            {
213
              /* Break out of the loop.  */
214
              rptr = NULL;
215
              break;
216
            }
217
          else
218
            {
219
              rcount[n]++;
220
              rptr += rstride[n];
221
            }
222
        }
223
      /* Advance to the next source element.  */
224
      n = 0;
225
      while (scount[n] == sextent[n])
226
        {
227
          /* When we get to the end of a dimension, reset it and increment
228
             the next dimension.  */
229
          scount[n] = 0;
230
          /* We could precalculate these products, but this is a less
231
             frequently used path so proabably not worth it.  */
232
          src -= sstride[n] * sextent[n];
233
          n++;
234
          if (n == sdim)
235
            {
236
              if (sptr && pad)
237
                {
238
                  /* Switch to the pad array.  */
239
                  sptr = NULL;
240
                  sdim = pdim;
241
                  for (dim = 0; dim < pdim; dim++)
242
                    {
243
                      scount[dim] = pcount[dim];
244
                      sextent[dim] = pextent[dim];
245
                      sstride[dim] = pstride[dim];
246
                      sstride0 = sstride[0];
247
                    }
248
                }
249
              /* We now start again from the beginning of the pad array.  */
250
              src = pptr;
251
              break;
252
            }
253
          else
254
            {
255
              scount[n]++;
256
              src += sstride[n];
257
            }
258
        }
259
    }
260
}
261
 
262
#endif

powered by: WebSVN 2.1.0

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