1/* Implementation of the SHAPE intrinsic 2 Copyright (C) 2002-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_INTEGER_16) 30 31extern void shape_16 (gfc_array_i16 * const restrict ret, 32 const array_t * const restrict array); 33export_proto(shape_16); 34 35void 36shape_16 (gfc_array_i16 * const restrict ret, 37 const array_t * const restrict array) 38{ 39 index_type stride; 40 index_type extent; 41 42 int rank = GFC_DESCRIPTOR_RANK (array); 43 44 if (ret->base_addr == NULL) 45 { 46 GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); 47 ret->offset = 0; 48 ret->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16)); 49 } 50 51 stride = GFC_DESCRIPTOR_STRIDE(ret,0); 52 53 if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) 54 return; 55 56 for (index_type n = 0; n < rank; n++) 57 { 58 extent = GFC_DESCRIPTOR_EXTENT(array,n); 59 ret->base_addr[n * stride] = extent > 0 ? extent : 0 ; 60 } 61} 62 63#endif 64