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/fmtchk.c 92.2 06/18/99 19:52:04" 00039 #include <cray/fmtconv.h> 00040 #include <cray/format.h> 00041 #include "fmt.h" 00042 00043 /* 00044 * The _wr_ilchk and _rd_ilchk arrays check edit-descriptors against the 00045 * internal length (container size in bytes) of an I/O list item. 00046 * 00047 * These tables can be viewed as a two-dimensional array with the internal 00048 * length measured in bytes along the x-axis and the edit-descriptor along the 00049 * y-axis. Each byte along the x-axis is interpreted as follows: 00050 * 00051 * INVALID_INTLEN - this combination is invalid 00052 * != INVALID_INTLEN - the mode bits passed to the input or output 00053 * data conversion function. 00054 * 00055 * 00056 * Character variables should not be indexed into this table. The internal 00057 * length used to lookup complex I/O list items should be the length of only 00058 * one component (real or imaginary part) of the complex value. 00059 */ 00060 00061 #define D ((signed char) MODEDP) /* 16 byte real */ 00062 #define U ((signed char) MODEUN) /* unsigned integer output */ 00063 00064 #ifdef MODEHP 00065 #define H ((signed char) MODEHP) /* 4 byte data */ 00066 #else 00067 #define H INVALID_INTLEN /* 4 byte data not supported */ 00068 #endif 00069 00070 #ifdef MODEWP 00071 #define W ((signed char) MODEWP) /* 2 byte data */ 00072 #else 00073 #define W INVALID_INTLEN /* 4 byte data not supported */ 00074 #endif 00075 00076 #ifdef MODEBP 00077 #define B ((signed char) MODEBP) /* 1 byte data */ 00078 #else 00079 #define B INVALID_INTLEN /* 4 byte data not supported */ 00080 #endif 00081 00082 #define HU (H | U) 00083 #define DU (D | U) 00084 #define WU (W | U) 00085 #define BU (B | U) 00086 00087 #define _ INVALID_INTLEN 00088 00089 signed char 00090 _wr_ilchk[LAST_DATA_ED][MAX_SUP_INTLEN] = { 00091 /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 */ 00092 { 0, 0, _, 0, _, _, _, 0, _, _, _, _, _, _, _, 0 }, /* A */ 00093 { BU,WU, _,HU, _, _, _, U, _, _, _, _, _, _, _, DU }, /* B */ 00094 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* D */ 00095 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* E */ 00096 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* EN */ 00097 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* ES */ 00098 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* F */ 00099 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* G */ 00100 { B, W, _, H, _, _, _, 0, _, _, _, _, _, _, _, _ }, /* I */ 00101 { B, W, _, H, _, _, _, 0, _, _, _, _, _, _, _, _ }, /* L */ 00102 { BU,WU, _,HU, _, _, _, U, _, _, _, _, _, _, _, DU }, /* O */ 00103 { 0, 0, _, 0, _, _, _, 0, _, _, _, _, _, _, _, 0 }, /* R */ 00104 { BU,WU, _,HU, _, _, _, U, _, _, _, _, _, _, _, DU }, /* Z */ 00105 { 0, 0, _, 0, _, _, _, 0, _, _, _, _, _, _, _, _ } /* Q */ 00106 }; 00107 00108 signed char 00109 _rd_ilchk[LAST_DATA_ED][MAX_SUP_INTLEN] = { 00110 /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 */ 00111 { 0, 0, _, 0, _, _, _, 0, _, _, _, _, _, _, _, 0 }, /* A */ 00112 { BU,WU, _, H, _, _, _, 0, _, _, _, _, _, _, _, _ }, /* B */ 00113 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* D */ 00114 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* E */ 00115 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* EN */ 00116 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* ES */ 00117 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* F */ 00118 { _, _, _, H, _, _, _, 0, _, _, _, _, _, _, _, D }, /* G */ 00119 { B, W, _, H, _, _, _, 0, _, _, _, _, _, _, _, _ }, /* I */ 00120 { B, W, _, H, _, _, _, 0, _, _, _, _, _, _, _, _ }, /* L */ 00121 { BU,WU, _, H, _, _, _, 0, _, _, _, _, _, _, _, _ }, /* O */ 00122 { 0, 0, _, 0, _, _, _, 0, _, _, _, _, _, _, _, 0 }, /* R */ 00123 { BU,WU, _, H, _, _, _, 0, _, _, _, _, _, _, _, _ }, /* Z */ 00124 { 0, 0, _, 0, _, _, _, 0, _, _, _, _, _, _, _, _ } /* Q */ 00125 }; 00126 00127 /* 00128 * The _rw_mxdgt array yields the maximum number of "digits" for a 00129 * specified data edit-descriptor and datum size (in bytes). This 00130 * is used for zero-width formatted I/O. 00131 * 00132 * The floating-point sizes (D through G edit-descriptors) are set 00133 * at run-time by the formatted I/O setup routine. 00134 */ 00135 00136 #undef _ 00137 #define _ ((signed char) -100) 00138 00139 signed char 00140 _rw_mxdgt[LAST_DATA_ED][MAX_SUP_INTLEN] = { 00141 /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 */ 00142 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* A */ 00143 { 8,16, _,32, _, _, _,64, _, _, _, _, _, _, _,127}, /* B */ 00144 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* D */ 00145 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* E */ 00146 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* EN */ 00147 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* ES */ 00148 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* F */ 00149 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* G */ 00150 { 3, 5, _,10, _, _, _,19, _, _, _, _, _, _, _, _ }, /* I */ 00151 { 2, 2, _, 2, _, _, _, 2, _, _, _, _, _, _, _, _ }, /* L */ 00152 { 3, 6, _,11, _, _, _,22, _, _, _, _, _, _, _,44 }, /* O */ 00153 { _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ }, /* R */ 00154 { 2, 4, _, 8, _, _, _,16, _, _, _, _, _, _, _,32 }, /* Z */ 00155 { 0, 0, _, 0, _, _, _, 0, _, _, _, _, _, _, _, _ } /* Q */ 00156 }; 00157 00158 /* 00159 * The following arrays are used to do error checking of edit-descriptors 00160 * against the data type of I/O list items. Versions $RNOCHK and $WNOCHK 00161 * may be loaded with segldr(1). For example: 00162 * 00163 * -D EQUIV=$WNOCHK($WCHK) - and/or - 00164 * -D EQUIV=$RNOCHK($RCHK) 00165 * 00166 * The NOCHK versions allow more combinations of logical, real and integer 00167 * editing. These loader directives are available on CRI systems only. 00168 * 00169 * 00170 * The CHK77 versions allow only Fortran-77 conforming editing. 00171 * 00172 * The CHK90 versions allow only Fortran-90 conforming editing. 00173 * 00174 * These tables can be viewed as a two-dimensional array with the data type 00175 * along the y-axis and the edit-descriptor along the x-axis. Each position 00176 * along the x-axis is one bit, interpreted as follows: 00177 * 00178 * 0 This edit-descriptor and data type combination is allowed. 00179 * 1 This edit-descriptor and data type combination is NOT allowed. 00180 */ 00181 00182 /* 00183 * _RCHK defines the rules for Fortran READs. 00184 */ 00185 00186 fmtchk_t _RCHK[DVTYPE_ASCII] = { 00187 /* Q Z R O L I G F ES EN E D B A */ 00188 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Typeless */ 00189 { 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0 }, /* Integer */ 00190 { 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Real */ 00191 { 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Complex */ 00192 { 1, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 0 }, /* Logical */ 00193 { 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00194 }; 00195 00196 /* 00197 * _RNOCHK liberalizes the checks for integer, real and logical. 00198 */ 00199 00200 fmtchk_t _RNOCHK[DVTYPE_ASCII] = { 00201 /* Q Z R O L I G F ES EN E D B A */ 00202 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Typeless */ 00203 { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* Integer */ 00204 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Real */ 00205 { 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Complex */ 00206 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* Logical */ 00207 { 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00208 }; 00209 00210 /* 00211 * _RCHK77 defines the rules for Fortran-77 READs (strict conformance). 00212 */ 00213 00214 fmtchk_t _RCHK77[DVTYPE_ASCII] = { 00215 /* Q Z R O L I G F ES EN E D B A */ 00216 { 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0 }, /* Typeless */ 00217 { 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1 }, /* Integer */ 00218 { 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1 }, /* Real */ 00219 { 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1 }, /* Complex */ 00220 { 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1 }, /* Logical */ 00221 { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00222 }; 00223 00224 /* 00225 * _RCHK90 defines the rules for Fortran-90, READs (strict conformance). 00226 */ 00227 00228 fmtchk_t _RCHK90[DVTYPE_ASCII] = { 00229 /* Q Z R O L I G F ES EN E D B A */ 00230 { 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Typeless */ 00231 { 1, 0, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1 }, /* Integer */ 00232 { 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1 }, /* Real */ 00233 { 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1 }, /* Complex */ 00234 { 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1 }, /* Logical */ 00235 { 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00236 }; 00237 00238 /* 00239 * _WCHK defines the rules for Fortran WRITEs. 00240 */ 00241 00242 fmtchk_t _WCHK[DVTYPE_ASCII] = { 00243 /* Q Z R O L I G F ES EN E D B A */ 00244 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Typeless */ 00245 { 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0 }, /* Integer */ 00246 { 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Real */ 00247 { 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Complex */ 00248 { 1, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 0 }, /* Logical */ 00249 { 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00250 }; 00251 00252 /* 00253 * _WNOCHK liberalizes the checks for integer, real and logical. 00254 */ 00255 00256 fmtchk_t _WNOCHK[DVTYPE_ASCII] = { 00257 /* Q Z R O L I G F ES EN E D B A */ 00258 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Typeless */ 00259 { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* Integer */ 00260 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Real */ 00261 { 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Complex */ 00262 { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* Logical */ 00263 { 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00264 }; 00265 00266 /* 00267 * _WCHK77 defines the rules for Fortran-77 WRITEs (strict conformance). 00268 */ 00269 00270 fmtchk_t _WCHK77[DVTYPE_ASCII] = { 00271 /* Q Z R O L I G F ES EN E D B A */ 00272 { 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0 }, /* Typeless */ 00273 { 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1 }, /* Integer */ 00274 { 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1 }, /* Real */ 00275 { 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1 }, /* Complex */ 00276 { 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1 }, /* Logical */ 00277 { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00278 }; 00279 00280 /* 00281 * _WCHK90 defines the rules for Fortran-90, WRITEs (strict conformance). 00282 */ 00283 00284 fmtchk_t _WCHK90[DVTYPE_ASCII] = { 00285 00286 /* Q Z R O L I G F ES EN E D B A */ 00287 { 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* Typeless */ 00288 { 1, 0, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1 }, /* Integer */ 00289 { 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1 }, /* Real */ 00290 { 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1 }, /* Complex */ 00291 { 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1 }, /* Logical */ 00292 { 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0 } /* Character */ 00293 };