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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [runtime/] [in_pack_generic.c] - Blame information for rev 867

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn
/* Generic helper function for repacking arrays.
2
   Copyright 2003, 2004, 2005, 2007, 2009, 2010
3
   Free Software Foundation, Inc.
4
   Contributed 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
Libgfortran 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
extern void *internal_pack (gfc_array_char *);
33
export_proto(internal_pack);
34
 
35
void *
36
internal_pack (gfc_array_char * source)
37
{
38
  index_type count[GFC_MAX_DIMENSIONS];
39
  index_type extent[GFC_MAX_DIMENSIONS];
40
  index_type stride[GFC_MAX_DIMENSIONS];
41
  index_type stride0;
42
  index_type dim;
43
  index_type ssize;
44
  const char *src;
45
  char *dest;
46
  void *destptr;
47
  int n;
48
  int packed;
49
  index_type size;
50
  index_type type_size;
51
 
52
  type_size = GFC_DTYPE_TYPE_SIZE(source);
53
  size = GFC_DESCRIPTOR_SIZE (source);
54
  switch (type_size)
55
    {
56
    case GFC_DTYPE_INTEGER_1:
57
    case GFC_DTYPE_LOGICAL_1:
58
    case GFC_DTYPE_DERIVED_1:
59
      return internal_pack_1 ((gfc_array_i1 *) source);
60
 
61
    case GFC_DTYPE_INTEGER_2:
62
    case GFC_DTYPE_LOGICAL_2:
63
      return internal_pack_2 ((gfc_array_i2 *) source);
64
 
65
    case GFC_DTYPE_INTEGER_4:
66
    case GFC_DTYPE_LOGICAL_4:
67
      return internal_pack_4 ((gfc_array_i4 *) source);
68
 
69
    case GFC_DTYPE_INTEGER_8:
70
    case GFC_DTYPE_LOGICAL_8:
71
      return internal_pack_8 ((gfc_array_i8 *) source);
72
 
73
#if defined(HAVE_GFC_INTEGER_16)
74
    case GFC_DTYPE_INTEGER_16:
75
    case GFC_DTYPE_LOGICAL_16:
76
      return internal_pack_16 ((gfc_array_i16 *) source);
77
#endif
78
    case GFC_DTYPE_REAL_4:
79
      return internal_pack_r4 ((gfc_array_r4 *) source);
80
 
81
    case GFC_DTYPE_REAL_8:
82
      return internal_pack_r8 ((gfc_array_r8 *) source);
83
 
84
/* FIXME: This here is a hack, which will have to be removed when
85
   the array descriptor is reworked.  Currently, we don't store the
86
   kind value for the type, but only the size.  Because on targets with
87
   __float128, we have sizeof(logn double) == sizeof(__float128),
88
   we cannot discriminate here and have to fall back to the generic
89
   handling (which is suboptimal).  */
90
#if !defined(GFC_REAL_16_IS_FLOAT128)
91
# if defined (HAVE_GFC_REAL_10)
92
    case GFC_DTYPE_REAL_10:
93
      return internal_pack_r10 ((gfc_array_r10 *) source);
94
# endif
95
 
96
# if defined (HAVE_GFC_REAL_16)
97
    case GFC_DTYPE_REAL_16:
98
      return internal_pack_r16 ((gfc_array_r16 *) source);
99
# endif
100
#endif
101
 
102
    case GFC_DTYPE_COMPLEX_4:
103
      return internal_pack_c4 ((gfc_array_c4 *) source);
104
 
105
    case GFC_DTYPE_COMPLEX_8:
106
      return internal_pack_c8 ((gfc_array_c8 *) source);
107
 
108
/* FIXME: This here is a hack, which will have to be removed when
109
   the array descriptor is reworked.  Currently, we don't store the
110
   kind value for the type, but only the size.  Because on targets with
111
   __float128, we have sizeof(logn double) == sizeof(__float128),
112
   we cannot discriminate here and have to fall back to the generic
113
   handling (which is suboptimal).  */
114
#if !defined(GFC_REAL_16_IS_FLOAT128)
115
# if defined (HAVE_GFC_COMPLEX_10)
116
    case GFC_DTYPE_COMPLEX_10:
117
      return internal_pack_c10 ((gfc_array_c10 *) source);
118
# endif
119
 
120
# if defined (HAVE_GFC_COMPLEX_16)
121
    case GFC_DTYPE_COMPLEX_16:
122
      return internal_pack_c16 ((gfc_array_c16 *) source);
123
# endif
124
#endif
125
 
126
    case GFC_DTYPE_DERIVED_2:
127
      if (GFC_UNALIGNED_2(source->data))
128
        break;
129
      else
130
        return internal_pack_2 ((gfc_array_i2 *) source);
131
 
132
    case GFC_DTYPE_DERIVED_4:
133
      if (GFC_UNALIGNED_4(source->data))
134
        break;
135
      else
136
        return internal_pack_4 ((gfc_array_i4 *) source);
137
 
138
    case GFC_DTYPE_DERIVED_8:
139
      if (GFC_UNALIGNED_8(source->data))
140
        break;
141
      else
142
        return internal_pack_8 ((gfc_array_i8 *) source);
143
 
144
#ifdef HAVE_GFC_INTEGER_16
145
    case GFC_DTYPE_DERIVED_16:
146
      if (GFC_UNALIGNED_16(source->data))
147
        break;
148
      else
149
        return internal_pack_16 ((gfc_array_i16 *) source);
150
#endif
151
 
152
    default:
153
      break;
154
    }
155
 
156
  dim = GFC_DESCRIPTOR_RANK (source);
157
  ssize = 1;
158
  packed = 1;
159
  for (n = 0; n < dim; n++)
160
    {
161
      count[n] = 0;
162
      stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
163
      extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
164
      if (extent[n] <= 0)
165
        {
166
          /* Do nothing.  */
167
          packed = 1;
168
          break;
169
        }
170
 
171
      if (ssize != stride[n])
172
        packed = 0;
173
 
174
      ssize *= extent[n];
175
    }
176
 
177
  if (packed)
178
    return source->data;
179
 
180
   /* Allocate storage for the destination.  */
181
  destptr = internal_malloc_size (ssize * size);
182
  dest = (char *)destptr;
183
  src = source->data;
184
  stride0 = stride[0] * size;
185
 
186
  while (src)
187
    {
188
      /* Copy the data.  */
189
      memcpy(dest, src, size);
190
      /* Advance to the next element.  */
191
      dest += size;
192
      src += stride0;
193
      count[0]++;
194
      /* Advance to the next source element.  */
195
      n = 0;
196
      while (count[n] == extent[n])
197
        {
198
          /* When we get to the end of a dimension, reset it and increment
199
             the next dimension.  */
200
          count[n] = 0;
201
          /* We could precalculate these products, but this is a less
202
             frequently used path so probably not worth it.  */
203
          src -= stride[n] * extent[n] * size;
204
          n++;
205
          if (n == dim)
206
            {
207
              src = NULL;
208
              break;
209
            }
210
          else
211
            {
212
              count[n]++;
213
              src += stride[n] * size;
214
            }
215
        }
216
    }
217
  return destptr;
218
}

powered by: WebSVN 2.1.0

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