Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2.1 of the GNU Lesser General Public License 00007 as published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 #pragma ident "@(#) libfi/array/shape.c 92.2 07/07/99 15:52:02" 00038 #include <liberrno.h> 00039 #include <stddef.h> 00040 #include <cray/dopevec.h> 00041 #include <cray/portdefs.h> 00042 00043 #include <stdlib.h> 00044 00045 #define BITS_PER_BYTE (BITS_PER_WORD / BYTES_PER_WORD) 00046 00047 /* 00048 * SHAPE Returns the shape of an array or scalar. 00049 * If source pointer/allocatable array is not 00050 * associated/allocated, return an error. 00051 * If result rank one array has not been allocated, fill parts 00052 * of result dope vector and allocate space for result. 00053 * When an array, shape = extent. Otherwise, shape = zero. 00054 */ 00055 00056 void 00057 _SHAPE (DopeVectorType * result, 00058 DopeVectorType * source) 00059 { 00060 int rank; 00061 int numbytes; 00062 int *destarry; 00063 _f_int4 *resptr4; 00064 _f_int8 *resptr8; 00065 int loopj; 00066 00067 /* If source is a pointer/allocatable array, it must be 00068 * associated/allocated. */ 00069 if (source->p_or_a && !source->assoc) 00070 _lerror ( _LELVL_ABORT, FENMPTAR, "SHAPE"); 00071 00072 /* target is rank-one array with extent source.n_dim */ 00073 rank = source->n_dim; 00074 00075 /* If result array is not allocated */ 00076 if (!result->assoc) { 00077 result->base_addr.a.ptr = (void *) NULL; 00078 result->dimension[0].extent = rank; 00079 result->dimension[0].low_bound = 1; 00080 result->dimension[0].stride_mult = 00081 result->type_lens.int_len / (sizeof(_f_int) * 00082 BITS_PER_BYTE); 00083 numbytes = rank * BYTES_PER_WORD; 00084 if (rank != 0) { 00085 /* allocate rank in bytes for temporary array */ 00086 destarry = (void *) malloc (numbytes); 00087 if (destarry == NULL) 00088 _lerror(_LELVL_ABORT,FENOMEMY); 00089 result->base_addr.a.ptr = (void *) destarry; 00090 } 00091 result->orig_base = result->base_addr.a.ptr; 00092 result->orig_size = numbytes << 3; 00093 result->assoc = 1; 00094 } 00095 00096 if (result->type_lens.kind_or_star == 0) { 00097 if (result->type_lens.int_len == 64) { 00098 resptr8 = (_f_int8 *) result->base_addr.a.ptr; 00099 /* Retrieve extent */ 00100 for (loopj = 0; loopj < rank; loopj++) 00101 resptr8[loopj] = (_f_int8) 00102 source->dimension[loopj].extent; 00103 } else { 00104 resptr4 = (_f_int4 *) result->base_addr.a.ptr; 00105 /* Retrieve extent */ 00106 for (loopj = 0; loopj < rank; loopj++) 00107 resptr4[loopj] = (_f_int4) 00108 source->dimension[loopj].extent; 00109 } 00110 } else { 00111 if (result->type_lens.dec_len == 8) { 00112 resptr8 = (_f_int8 *) result->base_addr.a.ptr; 00113 /* Retrieve extent */ 00114 for (loopj = 0; loopj < rank; loopj++) 00115 resptr8[loopj] = (_f_int8) 00116 source->dimension[loopj].extent; 00117 } else if (result->type_lens.dec_len == 4) { 00118 resptr4 = (_f_int4 *) result->base_addr.a.ptr; 00119 /* Retrieve extent */ 00120 for (loopj = 0; loopj < rank; loopj++) 00121 resptr4[loopj] = (_f_int4) 00122 source->dimension[loopj].extent; 00123 } 00124 } 00125 }