inquire.c

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

Generated on Tue Nov 17 05:54:42 2009 for Open64 (mfef90, whirl2f, and IR tools) by  doxygen 1.6.1