in_pack_r10.c revision 1.1.1.3
1/* Helper function for repacking arrays. 2 Copyright (C) 2003-2022 Free Software Foundation, Inc. 3 Contributed by Paul Brook <paul@nowt.org> 4 5This file is part of the GNU Fortran runtime library (libgfortran). 6 7Libgfortran is free software; you can redistribute it and/or 8modify it under the terms of the GNU General Public 9License as published by the Free Software Foundation; either 10version 3 of the License, or (at your option) any later version. 11 12Libgfortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17Under Section 7 of GPL version 3, you are granted additional 18permissions described in the GCC Runtime Library Exception, version 193.1, as published by the Free Software Foundation. 20 21You should have received a copy of the GNU General Public License and 22a copy of the GCC Runtime Library Exception along with this program; 23see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 24<http://www.gnu.org/licenses/>. */ 25 26#include "libgfortran.h" 27 28 29#if defined (HAVE_GFC_REAL_10) 30 31/* Allocates a block of memory with internal_malloc if the array needs 32 repacking. */ 33 34GFC_REAL_10 * 35internal_pack_r10 (gfc_array_r10 * source) 36{ 37 index_type count[GFC_MAX_DIMENSIONS]; 38 index_type extent[GFC_MAX_DIMENSIONS]; 39 index_type stride[GFC_MAX_DIMENSIONS]; 40 index_type stride0; 41 index_type dim; 42 index_type ssize; 43 const GFC_REAL_10 *src; 44 GFC_REAL_10 * restrict dest; 45 GFC_REAL_10 *destptr; 46 int packed; 47 48 /* TODO: Investigate how we can figure out if this is a temporary 49 since the stride=0 thing has been removed from the frontend. */ 50 51 dim = GFC_DESCRIPTOR_RANK (source); 52 ssize = 1; 53 packed = 1; 54 for (index_type n = 0; n < dim; n++) 55 { 56 count[n] = 0; 57 stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); 58 extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); 59 if (extent[n] <= 0) 60 { 61 /* Do nothing. */ 62 packed = 1; 63 break; 64 } 65 66 if (ssize != stride[n]) 67 packed = 0; 68 69 ssize *= extent[n]; 70 } 71 72 if (packed) 73 return source->base_addr; 74 75 /* Allocate storage for the destination. */ 76 destptr = xmallocarray (ssize, sizeof (GFC_REAL_10)); 77 dest = destptr; 78 src = source->base_addr; 79 stride0 = stride[0]; 80 81 82 while (src) 83 { 84 /* Copy the data. */ 85 *(dest++) = *src; 86 /* Advance to the next element. */ 87 src += stride0; 88 count[0]++; 89 /* Advance to the next source element. */ 90 index_type n = 0; 91 while (count[n] == extent[n]) 92 { 93 /* When we get to the end of a dimension, reset it and increment 94 the next dimension. */ 95 count[n] = 0; 96 /* We could precalculate these products, but this is a less 97 frequently used path so probably not worth it. */ 98 src -= stride[n] * extent[n]; 99 n++; 100 if (n == dim) 101 { 102 src = NULL; 103 break; 104 } 105 else 106 { 107 count[n]++; 108 src += stride[n]; 109 } 110 } 111 } 112 return destptr; 113} 114 115#endif 116 117