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/ubound.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 * UBOUND Returns the upper bounds for an array in a rank one result 00049 * array. The null argument DIM is present but not used. 00050 * If source pointer/allocatable array is not 00051 * associated/allocated, return an error. 00052 * If result rank one array has not been allocated, fill parts 00053 * of result dope vector and allocate space for result. 00054 * When extent of dimension is nonzero, return ubound= 00055 * (low_bound+extent)-1. Otherwise, return ubound=zero. 00056 */ 00057 00058 void 00059 _UBOUND (DopeVectorType * result, 00060 DopeVectorType * source, 00061 _f_int * dimptr) 00062 { 00063 int rank; 00064 int numbytes; 00065 int *destarry; 00066 _f_int4 *resptr4; 00067 _f_int8 *resptr8; 00068 int loopj; 00069 00070 /* If source is a pointer/allocatable array, it must be 00071 * associated/allocated. */ 00072 if (source->p_or_a && !source->assoc) 00073 _lerror (_LELVL_ABORT, FENMPTAR, "UBOUND"); 00074 00075 /* target is rank-one array with extent source.n_dim */ 00076 rank = source->n_dim; 00077 00078 /* If result array is not allocated */ 00079 if (!result->assoc) { 00080 result->base_addr.a.ptr = (void *) NULL; 00081 result->dimension[0].extent = rank; 00082 result->dimension[0].low_bound = 1; 00083 result->dimension[0].stride_mult = 00084 result->type_lens.int_len / (sizeof(_f_int) * 00085 BITS_PER_BYTE); 00086 numbytes = rank * BYTES_PER_WORD; 00087 /* allocate rank in bytes for temporary array */ 00088 destarry = (void *) malloc (numbytes); 00089 if (destarry == NULL) 00090 _lerror(_LELVL_ABORT, FENOMEMY); 00091 result->base_addr.a.ptr = (void *) destarry; 00092 result->assoc = 1; 00093 } 00094 00095 if (result->type_lens.kind_or_star == 0) { 00096 if (result->type_lens.int_len == 64) { 00097 resptr8 = (_f_int8 *) result->base_addr.a.ptr; 00098 for (loopj = 0; loopj < rank; loopj++) 00099 if(source->dimension[loopj].extent != 0) 00100 resptr8[loopj] = (_f_int8) 00101 (source->dimension[loopj].low_bound + 00102 source->dimension[loopj].extent) - 1; 00103 else 00104 resptr8[loopj] = (_f_int8) 0; 00105 } else { 00106 resptr4 = (_f_int4 *) result->base_addr.a.ptr; 00107 for (loopj = 0; loopj < rank; loopj++) 00108 if(source->dimension[loopj].extent != 0) 00109 resptr4[loopj] = (_f_int4) 00110 (source->dimension[loopj].low_bound + 00111 source->dimension[loopj].extent) - 1; 00112 else 00113 resptr4[loopj] = (_f_int4) 0; 00114 } 00115 } else { 00116 if (result->type_lens.dec_len == 8) { 00117 resptr8 = (_f_int8 *) result->base_addr.a.ptr; 00118 for (loopj = 0; loopj < rank; loopj++) 00119 if(source->dimension[loopj].extent != 0) 00120 resptr8[loopj] = (_f_int8) 00121 (source->dimension[loopj].low_bound + 00122 source->dimension[loopj].extent) - 1; 00123 else 00124 resptr8[loopj] = (_f_int8) 0; 00125 } else if (result->type_lens.dec_len == 4) { 00126 resptr4 = (_f_int4 *) result->base_addr.a.ptr; 00127 for (loopj = 0; loopj < rank; loopj++) 00128 if(source->dimension[loopj].extent != 0) 00129 resptr4[loopj] = (_f_int4) 00130 (source->dimension[loopj].low_bound + 00131 source->dimension[loopj].extent) - 1; 00132 else 00133 resptr4[loopj] = (_f_int4) 0; 00134 } 00135 } 00136 } 00137 00138 /* 00139 * UBOUND0 Returns scalar low_bound for a specified dimension DIM of 00140 * the source array. 00141 * If the source pointer/allocatable array is not 00142 * associated/alloced. return an error. 00143 * If DIM is outside rank of the array, return an error. 00144 * When extent of dimension is nonzero, return ubound= 00145 * low_bound+extent)-1. Otherwise, return ubound=zero. 00146 */ 00147 00148 _f_int 00149 _UBOUND0(DopeVectorType * source, 00150 _f_int * dimptr) 00151 { 00152 int iresult; 00153 int dim; 00154 int rank; 00155 00156 /* If source is a pointer/allocatable array, it must be 00157 * associated/allocated. */ 00158 if (source->p_or_a && !source->assoc) 00159 _lerror (_LELVL_ABORT, FENMPTAR, "UBOUND"); 00160 00161 /* argument DIM must be within source array rank */ 00162 rank = source->n_dim; 00163 dim = *dimptr - 1; 00164 if (dim < 0 || dim >= rank) 00165 _lerror (_LELVL_ABORT, FENMSCDM, "UBOUND"); 00166 00167 /* Return low_bound+extent-1 for nonzero extent, else return zero */ 00168 if(source->dimension[dim].extent != 0) 00169 iresult = (source->dimension[dim].low_bound + 00170 source->dimension[dim].extent) - 1; 00171 else 00172 iresult = 0; 00173 00174 return(iresult); 00175 } 00176 00177 /* 00178 * UBOUND0_4 Returns scalar low_bound for a specified dimension DIM of 00179 * the source array. 00180 * If the source pointer/allocatable array is not 00181 * associated/alloced. return an error. 00182 * If DIM is outside rank of the array, return an error. 00183 * When extent of dimension is nonzero, return ubound= 00184 * low_bound+extent)-1. Otherwise, return ubound=zero. 00185 */ 00186 00187 #if defined (_CRAY1) || defined (_CRAYMPP) 00188 #pragma duplicate _UBOUND0_4 as _UBOUND0_2 00189 #pragma duplicate _UBOUND0_4 as _UBOUND0_1 00190 #endif 00191 00192 _f_int4 00193 _UBOUND0_4(DopeVectorType * source, 00194 _f_int *dimptr) 00195 { 00196 _f_int4 iresult; 00197 int dim; 00198 int rank; 00199 00200 /* If source is a pointer/allocatable array, it must be 00201 * associated/allocated. */ 00202 if (source->p_or_a && !source->assoc) 00203 _lerror (_LELVL_ABORT, FENMPTAR, "UBOUND"); 00204 00205 /* argument DIM must be within source array rank */ 00206 rank = source->n_dim; 00207 dim = *dimptr - 1; 00208 if (dim < 0 || dim >= rank) 00209 _lerror (_LELVL_ABORT, FENMSCDM, "UBOUND"); 00210 00211 /* Return low_bound+extent-1 for nonzero extent, else return zero */ 00212 if(source->dimension[dim].extent != 0) 00213 iresult = (_f_int4) (source->dimension[dim].low_bound + 00214 source->dimension[dim].extent) - 1; 00215 else 00216 iresult = (_f_int4) 0; 00217 00218 return(iresult); 00219 } 00220 00221 /* 00222 * UBOUND0_8 Returns scalar low_bound for a specified dimension DIM of 00223 * the source array. 00224 * If the source pointer/allocatable array is not 00225 * associated/alloced. return an error. 00226 * If DIM is outside rank of the array, return an error. 00227 * When extent of dimension is nonzero, return ubound= 00228 * low_bound+extent)-1. Otherwise, return ubound=zero. 00229 */ 00230 00231 _f_int8 00232 _UBOUND0_8(DopeVectorType * source, 00233 _f_int * dimptr) 00234 { 00235 _f_int8 iresult; 00236 int dim; 00237 int rank; 00238 00239 /* If source is a pointer/allocatable array, it must be 00240 * associated/allocated. */ 00241 if (source->p_or_a && !source->assoc) 00242 _lerror (_LELVL_ABORT, FENMPTAR, "UBOUND"); 00243 00244 /* argument DIM must be within source array rank */ 00245 rank = source->n_dim; 00246 dim = *dimptr - 1; 00247 if (dim < 0 || dim >= rank) 00248 _lerror (_LELVL_ABORT, FENMSCDM, "UBOUND"); 00249 00250 /* Return low_bound+extent-1 for nonzero extent, else return zero */ 00251 if(source->dimension[dim].extent != 0) 00252 iresult = (_f_int8) (source->dimension[dim].low_bound + 00253 source->dimension[dim].extent) - 1; 00254 else 00255 iresult = (_f_int8) 0; 00256 00257 return(iresult); 00258 }