|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
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/inquire.c 92.1 06/21/99 10:37:55" 00039 00040 #include <errno.h> 00041 #include <limits.h> 00042 #include <stdlib.h> 00043 #include <string.h> 00044 #include <cray/assign.h> 00045 #include <sys/types.h> 00046 #include <sys/stat.h> 00047 #include "fio.h" 00048 00049 00050 /* 00051 * _f_inqu - process INQUIRE statement. 00052 * 00053 * Return value 00054 * Returns 0 on success, positive error code if an error 00055 * is encountered and ERR= or IOSTAT= are unspecified. 00056 * This routine aborts on error conditions if no ERR= 00057 * or IOSTAT= are specified. 00058 */ 00059 _f_inqu( 00060 FIOSPTR css, /* statement state */ 00061 unit *cup, /* locked unit pointer if INQUIRE by 00062 * unit and unit is connected. */ 00063 inlist *a) /* list of INQUIRE specifiers */ 00064 { 00065 int aifound; /* Assign info found flag */ 00066 int byfile; /* INQUIRE by file/unit flag */ 00067 int exists; /* File exists flag */ 00068 int opened; /* File opened flag */ 00069 int valunit; /* Valid unit number flag */ 00070 int errn; 00071 char *buf, *fn, *s; 00072 struct stat st; /* Stat system call packet */ 00073 assign_info ai; /* Assign information packet */ 00074 unit *p; 00075 00076 p = cup; 00077 errn = 0; 00078 00079 /* 00080 * Lock _openlock to ensure that no other task opens or closes units 00081 * during the unit table scan for inquire-by-file processing. 00082 */ 00083 OPENLOCK(); 00084 00085 if (a->infile != NULL) /* if INQUIRE by file */ 00086 byfile = 1; 00087 else { /* else INQUIRE by unit */ 00088 byfile = 0; 00089 valunit = GOOD_UNUM(a->inunit) && 00090 !RSVD_UNUM(a->inunit); /* Valid Unit Number? */ 00091 } 00092 00093 if ((buf = malloc(MAX(a->infilen + 1, MXUNITSZ + 1))) == NULL) { 00094 errn = FENOMEMY; 00095 if (a->inerr) 00096 goto out_of_here; 00097 _ferr(css, errn); 00098 } 00099 00100 *buf = '\0'; /* Assume no name */ 00101 opened = 0; /* Assume not opened */ 00102 fn = buf; 00103 00104 if (byfile) { /* If INQUIRE by file */ 00105 00106 _copy_n_trim(a->infile, a->infilen, buf); 00107 00108 if ((aifound = _get_a_options(0, buf, -1, 0, &ai, NULL, 00109 _LELVL_RETURN)) == -1) { 00110 00111 errn = errno; 00112 00113 if (a->inerr) { 00114 free(buf); 00115 goto out_of_here; 00116 } 00117 _ferr(css, errn); 00118 } 00119 00120 if (aifound && ai.a_actfil_flg) /* If assign alias */ 00121 s = ai.a_actfil; /* Use -a attribute as file name */ 00122 else 00123 s = buf; 00124 00125 exists = (stat(s, &st) != -1); 00126 00127 if (exists) { 00128 00129 p = _get_next_unit(NULL, 1, 1); 00130 00131 while (p != NULL) { /* while more open units */ 00132 unum_t unum; 00133 00134 unum = p->uid; 00135 00136 if (! RSVD_UNUM(unum) && 00137 (p->uinode == st.st_ino) && 00138 (p->udevice == st.st_dev)) { 00139 fn = p->ufnm; 00140 opened = 1; 00141 break; 00142 } 00143 p = _get_next_unit(p, 1, 1); 00144 } 00145 /* 00146 * If p is non-null here, it points to a locked unit. 00147 * The unit is locked to ensure a consistent set of 00148 * INQUIRE'd attributes is returned. 00149 */ 00150 } 00151 } 00152 else { /* Else INQUIRE by unit */ 00153 if (valunit) { 00154 opened = (cup != NULL); 00155 if (opened) { /* If opened, get name */ 00156 p = cup; 00157 fn = p->ufnm; 00158 } 00159 } 00160 } 00161 00162 if (fn == NULL) /* If no name available, return blanks */ 00163 fn = ""; 00164 00165 /* EXIST specifier */ 00166 00167 if (a->inex != NULL) 00168 if (byfile) /* If INQUIRE by file */ 00169 *a->inex = _btol(exists); 00170 else /* INQUIRE by unit */ 00171 *a->inex = _btol(valunit); 00172 00173 /* OPENED specifier */ 00174 00175 if (a->inopen != NULL) 00176 *a->inopen = _btol(opened); 00177 00178 /* NAMED specifier */ 00179 00180 if (a->innamed != NULL) 00181 if (byfile) /* If INQUIRE by file */ 00182 *a->innamed = _btol(1); /* .TRUE. */ 00183 else /* INQUIRE by unit */ 00184 *a->innamed = _btol(opened && p->ufnm != NULL); 00185 00186 /* NUMBER specifier */ 00187 00188 if (a->innum != NULL) { 00189 if (opened) { 00190 if (byfile) /* If INQUIRE by file */ 00191 *a->innum = (opened) ? p->uid : -1; 00192 else /* INQUIRE by unit */ 00193 *a->innum = a->inunit; /* The law of identity */ 00194 } 00195 else 00196 *a->innum = -1; 00197 } 00198 00199 /* RECL specifier */ 00200 00201 if (a->inrecl != NULL) 00202 if (opened) { 00203 if (p->urecl > 0) /* If recl was specified */ 00204 *a->inrecl = p->urecl; 00205 else /* Recl not specified (i.e., sequential) */ 00206 *a->inrecl = (p->ufmt) ? p->urecsize : LONG_MAX; 00207 } 00208 else 00209 *a->inrecl = -1; 00210 00211 /* NEXTREC specifier */ 00212 00213 if (a->innrec != NULL) 00214 if (opened && p->useq == 0) /* If opened & direct access */ 00215 *a->innrec = p->udalast + 1; 00216 else 00217 *a->innrec = -1; 00218 00219 /* NAME specifier */ 00220 00221 if (a->inname != NULL) 00222 _b_char(fn, a->inname, a->innamlen); 00223 00224 /* ACCESS specifier */ 00225 00226 if (a->inacc != NULL) { 00227 if (opened) 00228 s = (p->useq) ? "SEQUENTIAL" : "DIRECT"; 00229 else 00230 s = "UNDEFINED"; 00231 _b_char(s, a->inacc, a->inacclen); 00232 } 00233 00234 /* SEQUENTIAL specifier */ 00235 00236 if (a->inseq != NULL) { 00237 if (opened) 00238 s = (p->useq) ? "YES" : "NO"; 00239 else 00240 s = "UNKNOWN"; 00241 _b_char(s, a->inseq, a->inseqlen); 00242 } 00243 00244 /* DIRECT specifier */ 00245 00246 if (a->indir != NULL) { 00247 if (opened) 00248 s = (p->useq) ? "NO" : "YES"; 00249 else 00250 s = "UNKNOWN"; 00251 _b_char(s, a->indir, a->indirlen); 00252 } 00253 00254 /* FORM specifier */ 00255 00256 if (a->inform != NULL) { 00257 if (opened) 00258 s = (p->ufmt) ? "FORMATTED" : "UNFORMATTED"; 00259 else 00260 s = "UNDEFINED"; 00261 _b_char(s, a->inform, (ftnlen)a->informlen); 00262 } 00263 00264 /* FORMATTED specifier */ 00265 00266 if (a->infmt != NULL) { 00267 if (opened) 00268 s = (p->ufmt) ? "YES" : "NO"; 00269 else 00270 s = "UNKNOWN"; 00271 _b_char(s, a->infmt, a->infmtlen); 00272 } 00273 00274 /* UNFORMATTED specifier */ 00275 00276 if (a->inunf != NULL) { 00277 if (opened) 00278 s = (p->ufmt) ? "NO" : "YES"; 00279 else 00280 s = "UNKNOWN"; 00281 _b_char(s, a->inunf, a->inunflen); 00282 } 00283 00284 /* BLANK specifier */ 00285 00286 if (a->inblank != NULL) { 00287 if (opened && p->ufmt) 00288 s = (p->ublnk) ? "ZERO" : "NULL"; 00289 else 00290 s = "UNDEFINED"; 00291 _b_char(s, a->inblank, a->inblanklen); 00292 } 00293 00294 /* POSITION specifier */ 00295 00296 if (a->inposit != NULL) { /* Fortran 90 position control */ 00297 if (opened && p->useq) { 00298 switch (p->uposition) { 00299 case OS_REWIND: 00300 s = "REWIND"; 00301 break; 00302 case OS_ASIS: 00303 s = "ASIS"; 00304 break; 00305 case OS_APPEND: 00306 s = "APPEND"; 00307 break; 00308 case 0: 00309 s = "UNKNOWN"; 00310 break; 00311 default: 00312 _ferr(css, FEINTUNK); 00313 } 00314 } 00315 else 00316 s = "UNDEFINED"; 00317 _b_char(s, a->inposit, a->inpositlen); 00318 } 00319 00320 /* ACTION specifier */ 00321 00322 if (a->inaction != NULL) { /* Fortran 90 action control */ 00323 if (opened) { 00324 switch (p->uaction) { 00325 case OS_READWRITE: 00326 s = "READWRITE"; 00327 break; 00328 case OS_READ: 00329 s = "READ"; 00330 break; 00331 case OS_WRITE: 00332 s = "WRITE"; 00333 break; 00334 default: 00335 _ferr(css, FEINTUNK); 00336 } 00337 } 00338 else /* for an unconnected file */ 00339 s = "UNDEFINED"; 00340 _b_char(s, a->inaction, a->inactonlen); 00341 } 00342 00343 /* READ specifier */ 00344 00345 if (a->inread != NULL) { /* Fortran 90 read action control */ 00346 if (opened) { 00347 if ((p->uaction == OS_READ) || 00348 (p->uaction == OS_READWRITE)) 00349 s = "YES"; 00350 else 00351 s = "NO"; 00352 } 00353 else 00354 s = "UNKNOWN"; 00355 _b_char(s, a->inread, a->inreadlen); 00356 } 00357 00358 /* WRITE specifier */ 00359 00360 if (a->inwrite != NULL) { /* Fortran 90 write action control */ 00361 if (opened) { 00362 if ((p->uaction == OS_WRITE) || 00363 (p->uaction == OS_READWRITE)) 00364 s = "YES"; 00365 else 00366 s = "NO"; 00367 } 00368 else 00369 s = "UNKNOWN"; 00370 _b_char(s, a->inwrite, a->inwritelen); 00371 } 00372 00373 /* READWRITE specifier */ 00374 00375 if (a->inredwrit != NULL) { /* Fortran 90 read/write action control */ 00376 if (opened) { 00377 if (p->uaction == OS_READWRITE) 00378 s = "YES"; 00379 else 00380 s = "NO"; 00381 } 00382 else 00383 s = "UNKNOWN"; 00384 _b_char(s, a->inredwrit, a->inrdwrtlen); 00385 } 00386 00387 /* DELIM specifier */ 00388 00389 if (a->indelim != NULL) { /* Fortran 90 delim control */ 00390 if (opened && p->ufmt) { /* if formatted */ 00391 switch (p->udelim) { 00392 case OS_NONE: 00393 s = "NONE"; 00394 break; 00395 case OS_QUOTE: 00396 s = "QUOTE"; 00397 break; 00398 case OS_APOSTROPHE: 00399 s = "APOSTROPHE"; 00400 break; 00401 default: 00402 _ferr(css, FEINTUNK); 00403 } 00404 } 00405 else /* UNDEFINED for unformatted or unconnected file */ 00406 s = "UNDEFINED"; 00407 _b_char(s, a->indelim, a->indelimlen); 00408 } 00409 00410 /* PAD specifier */ 00411 00412 if (a->inpad != NULL) { /* Fortran 90 pad control */ 00413 if(opened && p->ufmt) { /* if formatted */ 00414 switch (p->upad) { 00415 case OS_YES: 00416 s = "YES"; 00417 break; 00418 case OS_NO: 00419 s = "NO"; 00420 break; 00421 default: 00422 _ferr(css, FEINTUNK); 00423 } 00424 } 00425 else /* Fortran 90 missed UNDEFINED if unformatted or unconnected */ 00426 s = "YES"; /* set to YES instead of UNDEFINED */ 00427 _b_char(s, a->inpad, a->inpadlen); 00428 } 00429 00430 /* 00431 * Unlock the unit if we have a pointer to an open unit. Note that 00432 * $INQ/_INQUIRE never unlocks the unit. 00433 */ 00434 out_of_here: 00435 00436 OPENUNLOCK(); 00437 00438 if (p != NULL) 00439 _release_cup(p); /* unlock the unit */ 00440 00441 free(buf); 00442 return(errn); 00443 }
1.7.6.1 
