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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn
/* Specific implementation of the UNPACK intrinsic
2
   Copyright 2008, 2009 Free Software Foundation, Inc.
3
   Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>, based on
4
   unpack_generic.c by Paul Brook <paul@nowt.org>.
5
 
6
This file is part of the GNU Fortran 95 runtime library (libgfortran).
7
 
8
Libgfortran is free software; you can redistribute it and/or
9
modify it under the terms of the GNU General Public
10
License as published by the Free Software Foundation; either
11
version 3 of the License, or (at your option) any later version.
12
 
13
Ligbfortran is distributed in the hope that it will be useful,
14
but WITHOUT ANY WARRANTY; without even the implied warranty of
15
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
GNU General Public License for more details.
17
 
18
Under Section 7 of GPL version 3, you are granted additional
19
permissions described in the GCC Runtime Library Exception, version
20
3.1, as published by the Free Software Foundation.
21
 
22
You should have received a copy of the GNU General Public License and
23
a copy of the GCC Runtime Library Exception along with this program;
24
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
25
<http://www.gnu.org/licenses/>.  */
26
 
27
#include "libgfortran.h"
28
#include <stdlib.h>
29
#include <assert.h>
30
#include <string.h>
31
 
32
 
33
#if defined (HAVE_GFC_REAL_4)
34
 
35
void
36
unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector,
37
                 const gfc_array_l1 *mask, const GFC_REAL_4 *fptr)
38
{
39
  /* r.* indicates the return array.  */
40
  index_type rstride[GFC_MAX_DIMENSIONS];
41
  index_type rstride0;
42
  index_type rs;
43
  GFC_REAL_4 * restrict rptr;
44
  /* v.* indicates the vector array.  */
45
  index_type vstride0;
46
  GFC_REAL_4 *vptr;
47
  /* Value for field, this is constant.  */
48
  const GFC_REAL_4 fval = *fptr;
49
  /* m.* indicates the mask array.  */
50
  index_type mstride[GFC_MAX_DIMENSIONS];
51
  index_type mstride0;
52
  const GFC_LOGICAL_1 *mptr;
53
 
54
  index_type count[GFC_MAX_DIMENSIONS];
55
  index_type extent[GFC_MAX_DIMENSIONS];
56
  index_type n;
57
  index_type dim;
58
 
59
  int empty;
60
  int mask_kind;
61
 
62
  empty = 0;
63
 
64
  mptr = mask->data;
65
 
66
  /* Use the same loop for all logical types, by using GFC_LOGICAL_1
67
     and using shifting to address size and endian issues.  */
68
 
69
  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
70
 
71
  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
72
#ifdef HAVE_GFC_LOGICAL_16
73
      || mask_kind == 16
74
#endif
75
      )
76
    {
77
      /*  Do not convert a NULL pointer as we use test for NULL below.  */
78
      if (mptr)
79
        mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind);
80
    }
81
  else
82
    runtime_error ("Funny sized logical array");
83
 
84
  if (ret->data == NULL)
85
    {
86
      /* The front end has signalled that we need to populate the
87
         return array descriptor.  */
88
      dim = GFC_DESCRIPTOR_RANK (mask);
89
      rs = 1;
90
      for (n = 0; n < dim; n++)
91
        {
92
          count[n] = 0;
93
          GFC_DIMENSION_SET(ret->dim[n], 0,
94
                            GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
95
          extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
96
          empty = empty || extent[n] <= 0;
97
          rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
98
          mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
99
          rs *= extent[n];
100
        }
101
      ret->offset = 0;
102
      ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_4));
103
    }
104
  else
105
    {
106
      dim = GFC_DESCRIPTOR_RANK (ret);
107
      for (n = 0; n < dim; n++)
108
        {
109
          count[n] = 0;
110
          extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
111
          empty = empty || extent[n] <= 0;
112
          rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
113
          mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
114
        }
115
      if (rstride[0] == 0)
116
        rstride[0] = 1;
117
    }
118
 
119
  if (empty)
120
    return;
121
 
122
  if (mstride[0] == 0)
123
    mstride[0] = 1;
124
 
125
  vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
126
  if (vstride0 == 0)
127
    vstride0 = 1;
128
  rstride0 = rstride[0];
129
  mstride0 = mstride[0];
130
  rptr = ret->data;
131
  vptr = vector->data;
132
 
133
  while (rptr)
134
    {
135
      if (*mptr)
136
        {
137
          /* From vector.  */
138
          *rptr = *vptr;
139
          vptr += vstride0;
140
        }
141
      else
142
        {
143
          /* From field.  */
144
          *rptr = fval;
145
        }
146
      /* Advance to the next element.  */
147
      rptr += rstride0;
148
      mptr += mstride0;
149
      count[0]++;
150
      n = 0;
151
      while (count[n] == extent[n])
152
        {
153
          /* When we get to the end of a dimension, reset it and increment
154
             the next dimension.  */
155
          count[n] = 0;
156
          /* We could precalculate these products, but this is a less
157
             frequently used path so probably not worth it.  */
158
          rptr -= rstride[n] * extent[n];
159
          mptr -= mstride[n] * extent[n];
160
          n++;
161
          if (n >= dim)
162
            {
163
              /* Break out of the loop.  */
164
              rptr = NULL;
165
              break;
166
            }
167
          else
168
            {
169
              count[n]++;
170
              rptr += rstride[n];
171
              mptr += mstride[n];
172
            }
173
        }
174
    }
175
}
176
 
177
void
178
unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector,
179
                 const gfc_array_l1 *mask, const gfc_array_r4 *field)
180
{
181
  /* r.* indicates the return array.  */
182
  index_type rstride[GFC_MAX_DIMENSIONS];
183
  index_type rstride0;
184
  index_type rs;
185
  GFC_REAL_4 * restrict rptr;
186
  /* v.* indicates the vector array.  */
187
  index_type vstride0;
188
  GFC_REAL_4 *vptr;
189
  /* f.* indicates the field array.  */
190
  index_type fstride[GFC_MAX_DIMENSIONS];
191
  index_type fstride0;
192
  const GFC_REAL_4 *fptr;
193
  /* m.* indicates the mask array.  */
194
  index_type mstride[GFC_MAX_DIMENSIONS];
195
  index_type mstride0;
196
  const GFC_LOGICAL_1 *mptr;
197
 
198
  index_type count[GFC_MAX_DIMENSIONS];
199
  index_type extent[GFC_MAX_DIMENSIONS];
200
  index_type n;
201
  index_type dim;
202
 
203
  int empty;
204
  int mask_kind;
205
 
206
  empty = 0;
207
 
208
  mptr = mask->data;
209
 
210
  /* Use the same loop for all logical types, by using GFC_LOGICAL_1
211
     and using shifting to address size and endian issues.  */
212
 
213
  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
214
 
215
  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
216
#ifdef HAVE_GFC_LOGICAL_16
217
      || mask_kind == 16
218
#endif
219
      )
220
    {
221
      /*  Do not convert a NULL pointer as we use test for NULL below.  */
222
      if (mptr)
223
        mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind);
224
    }
225
  else
226
    runtime_error ("Funny sized logical array");
227
 
228
  if (ret->data == NULL)
229
    {
230
      /* The front end has signalled that we need to populate the
231
         return array descriptor.  */
232
      dim = GFC_DESCRIPTOR_RANK (mask);
233
      rs = 1;
234
      for (n = 0; n < dim; n++)
235
        {
236
          count[n] = 0;
237
          GFC_DIMENSION_SET(ret->dim[n], 0,
238
                            GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
239
          extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
240
          empty = empty || extent[n] <= 0;
241
          rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
242
          fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
243
          mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
244
          rs *= extent[n];
245
        }
246
      ret->offset = 0;
247
      ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_4));
248
    }
249
  else
250
    {
251
      dim = GFC_DESCRIPTOR_RANK (ret);
252
      for (n = 0; n < dim; n++)
253
        {
254
          count[n] = 0;
255
          extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
256
          empty = empty || extent[n] <= 0;
257
          rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n);
258
          fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n);
259
          mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
260
        }
261
      if (rstride[0] == 0)
262
        rstride[0] = 1;
263
    }
264
 
265
  if (empty)
266
    return;
267
 
268
  if (fstride[0] == 0)
269
    fstride[0] = 1;
270
  if (mstride[0] == 0)
271
    mstride[0] = 1;
272
 
273
  vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0);
274
  if (vstride0 == 0)
275
    vstride0 = 1;
276
  rstride0 = rstride[0];
277
  fstride0 = fstride[0];
278
  mstride0 = mstride[0];
279
  rptr = ret->data;
280
  fptr = field->data;
281
  vptr = vector->data;
282
 
283
  while (rptr)
284
    {
285
      if (*mptr)
286
        {
287
          /* From vector.  */
288
          *rptr = *vptr;
289
          vptr += vstride0;
290
        }
291
      else
292
        {
293
          /* From field.  */
294
          *rptr = *fptr;
295
        }
296
      /* Advance to the next element.  */
297
      rptr += rstride0;
298
      fptr += fstride0;
299
      mptr += mstride0;
300
      count[0]++;
301
      n = 0;
302
      while (count[n] == extent[n])
303
        {
304
          /* When we get to the end of a dimension, reset it and increment
305
             the next dimension.  */
306
          count[n] = 0;
307
          /* We could precalculate these products, but this is a less
308
             frequently used path so probably not worth it.  */
309
          rptr -= rstride[n] * extent[n];
310
          fptr -= fstride[n] * extent[n];
311
          mptr -= mstride[n] * extent[n];
312
          n++;
313
          if (n >= dim)
314
            {
315
              /* Break out of the loop.  */
316
              rptr = NULL;
317
              break;
318
            }
319
          else
320
            {
321
              count[n]++;
322
              rptr += rstride[n];
323
              fptr += fstride[n];
324
              mptr += mstride[n];
325
            }
326
        }
327
    }
328
}
329
 
330
#endif
331
 

powered by: WebSVN 2.1.0

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