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 00038 #pragma ident "@(#) libf/fio/inqil.c 92.1 06/21/99 10:37:55" 00039 00040 #include <fortran.h> 00041 #include <liberrno.h> 00042 #include "fio.h" 00043 #include "f90io.h" 00044 00045 /* 00046 * Temporarily define infoflags structue. This will be removed when 00047 * it is added to f90io.h. 00048 */ 00049 00050 typedef struct InfoFlags { 00051 unsigned int version :8; /* contains InfoList Version */ 00052 unsigned int :24; /* reserved for future development */ 00053 unsigned int :8; /* reserved for future development */ 00054 unsigned int stksize :8; /* size in words of stack space */ 00055 /* passed as 3rd arg to _INQIL */ 00056 unsigned int :8; /* reserved for future development */ 00057 unsigned int icount :8; /* size of struct control list in */ 00058 /* words */ 00059 } InfoFlagsType; 00060 00061 _f_int 00062 _INQIL (InfoFlagsType *info, 00063 iolist_header *iolist, 00064 void *stck) 00065 { 00066 int num_ioentries; 00067 int f90_type; 00068 int int_len; 00069 ioentry_header *nextioh; 00070 void *nexte; 00071 int **indarray; 00072 long elsize; 00073 int i; 00074 int *iptr; 00075 00076 /* If first call, clear running total word in stack (word 1) */ 00077 00078 iptr = (int *) stck; 00079 if (iolist->iolfirst) { 00080 iptr[0] = 0; 00081 } 00082 00083 num_ioentries = iolist->icount; 00084 nextioh = (ioentry_header *) (iolist + 1); 00085 00086 /* 00087 * Run through loop until all items have been processed. A running 00088 * total of bytes will be maintained during the loop. This value will 00089 * be the result returned to the calling program. 00090 */ 00091 00092 while (num_ioentries--) { 00093 nexte = nextioh + 1; 00094 switch (nextioh->valtype) { 00095 case IO_SCALAR : 00096 { 00097 ioscalar_entry *se; 00098 00099 /* 00100 * All that is required for a scalar entry is to determine its length, 00101 * and increment the running total. 00102 */ 00103 se = nexte; 00104 f90_type = se->tinfo.type; 00105 int_len = se->tinfo.int_len; 00106 00107 if (f90_type == DVTYPE_ASCII) { 00108 const int bytesperchar = 1; 00109 /* 00110 * When 2-byte character is supported: 00111 * 00112 * int bytesperchar = (int_len >> 3); 00113 */ 00114 elsize = _fcdlen (se->iovar_address.fcd); 00115 elsize *= bytesperchar; 00116 } else { 00117 elsize = int_len >> 3; 00118 #if defined(_UNICOS) 00119 /* 00120 * Account for padding in PVP and MPP systems. Padding will occur 00121 * if the element size of the current element is greater than or equal 00122 * to the word size of the machine, and the current count of bytes is 00123 * not on a word boundary. 00124 */ 00125 if (elsize >= sizeof (long)) { 00126 i = iptr[0] & (sizeof(long) - 1); 00127 if (i) 00128 iptr[0] += sizeof(long) - i; 00129 } 00130 #endif 00131 } 00132 iptr[0] += elsize; 00133 break; 00134 } 00135 00136 case IO_DOPEVEC : 00137 { 00138 ioarray_entry *ae; 00139 00140 ae = nexte; 00141 if (ae->dv->type_lens.type == DVTYPE_ASCII) 00142 elsize = _fcdlen (ae->dv->base_addr.charptr); 00143 else { 00144 elsize = ae->dv->type_lens.int_len >> 3; 00145 00146 #if defined(_UNICOS) 00147 /* 00148 * Account for padding in PVP and MPP systems. Padding will occur 00149 * if the element size of the current element is greater than or equal 00150 * to the word size of the machine, and the current count of bytes is 00151 * not on a word boundary. 00152 */ 00153 if (elsize >= sizeof (long)) { 00154 i = iptr[0] & (sizeof(long) - 1); 00155 if (i) 00156 iptr[0] += sizeof(long) - i; 00157 } 00158 #endif 00159 } 00160 00161 /* 00162 * If indflag is not set, multiply the extents together to determine 00163 * the number of entries, and then multiply that number by the element 00164 * size to get the total number of bytes. 00165 */ 00166 if (!ae->indflag) { 00167 for (i = 0; i < ae->dv->n_dim; i++) 00168 elsize *= ae->dv->dimension[i].extent; 00169 00170 /* 00171 * If indflag is set, multiply the strides of all indices whose 00172 * corresponding entry in dovar is null. Assume that all entries whose 00173 * dovar equivalent is non_null are either 1, or will be calculated 00174 * elsewhere (IO_LOOP). 00175 */ 00176 } else { 00177 indarray = ae->dovar; 00178 for (i = 0; i < ae->dv->n_dim; i++) { 00179 if (indarray[i] == NULL) 00180 elsize *= ae->dv->dimension[i].extent; 00181 } 00182 } 00183 iptr[0] += elsize; 00184 break; 00185 } 00186 00187 case IO_LOOP : 00188 { 00189 long inc; 00190 long beg; 00191 long end; 00192 long ret; 00193 long tripcnt; 00194 ioimplieddo_entry *ie; 00195 long cntsave; 00196 00197 ie = nexte; 00198 inc = *ie->ioinccnt; 00199 beg = *ie->iobegcnt; 00200 end = *ie->ioendcnt; 00201 00202 /* 00203 * Determine number of times through loop will actually be done 00204 * This number will be multiplied by the number of iterations for 00205 * the remaining indices to get the total count. The remaining 00206 * indices will be determined by a recursive call to inqil. 00207 */ 00208 00209 if (inc < 0) { 00210 beg = -beg; 00211 end = -end; 00212 inc = -inc; 00213 } 00214 tripcnt = (end + inc - beg) / inc; 00215 if (tripcnt < 0) 00216 tripcnt = 0; 00217 00218 cntsave = iptr[0]; 00219 ret = _INQIL (info, (void *) (ie+1), stck); 00220 00221 /* 00222 * Since the calculated size is added to the total by the _INQIL call, 00223 * we need to multiply the returned count by the tripcnt - 1. 00224 */ 00225 iptr[0] += (ret - cntsave) * (tripcnt - 1); 00226 break; 00227 } 00228 00229 default : 00230 _lerror (_LELVL_ABORT, FEINTUNK); 00231 } 00232 00233 nextioh = (ioentry_header *) ((long *)nextioh + nextioh->ioentsize); 00234 } 00235 00236 return (iptr[0]); 00237 }