fopn.c

Go to the documentation of this file.

/*

  Copyright (C) 2000, 2001, Silicon Graphics, Inc.  All Rights Reserved.

  This program is free software; you can redistribute it and/or modify it
  under the terms of version 2.1 of the GNU Lesser General Public License 
  as published by the Free Software Foundation.

  This program is distributed in the hope that it would be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  

  Further, this software is distributed without any warranty that it is
  free of the rightful claim of any third person regarding infringement 
  or the like.  Any license provided herein, whether implied or 
  otherwise, applies only to this software file.  Patent licenses, if
  any, provided herein do not apply to combinations of this program with 
  other software, or any other product whatsoever.  

  You should have received a copy of the GNU Lesser General Public 
  License along with this program; if not, write the Free Software 
  Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 
  USA.

  Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
  Mountain View, CA 94043, or:

  http://www.sgi.com

  For further information regarding this notice, see:

  http://oss.sgi.com/projects/GenInfo/NoticeExplan

*/



#pragma ident "@(#) libf/fio/fopn.c     92.6    09/20/99 11:41:08"

#include <errno.h>
#include <fcntl.h>
#include <liberrno.h>
#ifndef _ABSOFT
#include <stdlib.h>
#endif
#include <stddef.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>
#include <stdlib.h>
#include <sys/stat.h>
#include <cray/nassert.h>
#ifdef  _UNICOS_MAX 
#include <mpp/globals.h>
#endif 
#include <cray/assign.h>
#include "fio.h"

#define TRACK   (42*BLKSIZE)    /* Most common track size */
#define FPARMAX         3       /* Number of numeric layer parameters */
#define SPECSZ  (FPARMAX+2+1)   /* Room for largest FFIO spec used */
                                /* FPARMAX + 1 for class + 1 for terminating zero spec */
                                /* + 1 for cachea layer shared cache specification */
                                /* (not used) */
#define ACCESS_PERMS    0666    /* Access permissions */

#if     defined(_LITTLE_ENDIAN) && !defined(__sv2)
#ifndef IOWRT
#define IOWRT   = _IO_CURRENTLY_PUTTING
#endif
#ifndef IORW
#define IORW    = _IO_TIED_PUTGET
#endif
extern FILE *fdopen(int, const char*);
#endif          /* LITTLE_ENDIAN and not sv2 */

extern int      __fdctrace_enable;
static int      _defbufsiz_warning;     /* set to 1 after first DEFBUFSIZ warning */

static int
make_fdspec(union spec_u *fdspec, char *layer, int intnum[FPARMAX]);

/*
 *      _f_opn - fortran open
 *
 *      Return value:
 *              0 if OK, -1 on error with errno set
 *
 *      Side effects:
 *              statp structure is made valid if not valid upon entry.
 */

int
_f_opn(
char            *actnam,        /* actual file name */
unit            *cup,
FIOSPTR         css,
int             tufs,           /* used to store ufs till open is OK */
                                /* cup->ufs set indicates open was OK */
int             aifound,        /* 1 if aip is valid */
assign_info     *aip,           /* assign information */
struct stat     *statp,         /* pointer to stat buf */
int             statp_valid,    /* 1 if statp is valid upon entry, 0 if the 
                                 * file has not yet been stat'ed */
int             catcherr,       /* nonzero if abort on errors */
int             o_sysflgs)      /* O_TRUNC/O_CREAT/O_EXCL */
{
        register short  default_ftype;  /* 1 iff no -s or -F assigned */
        register short  disk_file;
        register short  i;
        register short  not_open;
        register int    fd;
        register int    flags;
        register int    opt_flags;
        register int    acc_mode;
        int             num[FPARMAX];
        char            *ffio_layer;
        union spec_u    specspace[SPECSZ];
        union spec_u    *fdspec;
        struct fdinfo   *fio;
        struct ffsw     ffiostat;
        struct ffc_info_s info;
        struct ffc_stat_s ffio_statbuf;

        extern int      _def_cch_bufsiz;
#ifdef  _UNICOS_MAX
        extern int      _def_cch_simbufsiz;
#endif
        extern void     _ffconvert_stat(struct ffc_stat_s *src,
                                        struct stat *dest);

        disk_file       = 1;    /* assume a disk file */
        not_open        = 1;    /* file is not yet open */
        opt_flags       = 0;    /* set no optional flags */
        flags           = 0;
        fdspec          = NULL;

/*
 *      Lookup the environment variable which was used in UNICOS 6.0 to
 *      set the default buffer size and issue a warning if the user has set it.
 */
        if (_defbufsiz_warning == 0 && ((char *)getenv("DEFBUFSIZ") != NULL)) {
                _defbufsiz_warning      = 1; /* suppress subsequent warnings */
                _fwarn(FWDEFBSZ);
        }

/*
 *      If -s and -F are not assigned, set flag to indicate that the default
 *      file type is being used.
 */
        if (! aifound || (! aip->s_fstrct_flg && ! aip->F_filter_flg))
                default_ftype   = 1;
        else
                default_ftype   = 0;

/*
 *      Initialize unit table fields ucharset and unumcvrt.
 */
        if (aifound && aip->C_chrcnv_flg)
                cup->ucharset   = aip->C_chrcnv;
        else
                cup->ucharset   = 0;

        if (aifound && aip->N_datcnv_flg)
                cup->unumcvrt   = aip->N_datcnv;
        else
                cup->unumcvrt   = 0;

        if (cup->unumcvrt || cup->ucharset) {
/*
 *              Numeric conversion implies matching character
 *              conversion if not otherwise specified.  Also,
 *              change NCV_NATIVE and CS_NATIVE to zero to
 *              simplify run-time checking.
 */
                _setup_cvrt(cup);
        }

#if     NUMERIC_DATA_CONVERSION_ENABLED
/*
 *      cup->ualignmask is set to the alignment "granularity" - 1.  This
 *      provides a mask for fast checking of whether alignment is 
 *      needed.  Note that a value of zero really implies a granularity
 *      of 1 (ie no padding).
 */
        cup->ualign     = *__fndc_align[cup->unumcvrt];

        if (cup->unumcvrt == 0)
                cup->ualignmask = (sizeof(long) << 3) - 1;      /* 63 */
        else {
                cup->ualignmask = MAX(cup->ualign.gran, 1) - 1;
/*
 *              If granularity is not a power of 2, then we force a
 *              computation in COMPADD on every unformatted I/O request.
 */
                if ( ! POWER_OF_TWO(cup->ualignmask + 1) )
                        cup->ualignmask = ~0;   /* mask of one's */
        }
#endif
/*
 *      Set up sequential file truncation flag and the flag for special
 *      handling of muliply-accessed files.   Stdout and stderr default
 *      to no truncation after final write.   This is to avoid problems
 *      if SHMEM applications redirect stdout to a regular file.  A truncation
 *      at close time can result in lost output from another process 
 *      sharing the same stdout file.  
 */
        cup->utrunc     = 1;

        if (cup->ufp.std != NULL) {
                register int fd = fileno(cup->ufp.std);
                if (fd == STDOUT_FILENO || fd == STDERR_FILENO)
                        cup->utrunc     = 0;
        }

        if (aifound && aip->T_utrunc_flg)
                cup->utrunc     = aip->T_utrunc;

        if (aifound && aip->m_multup_flg && aip->m_multup) {
                cup->umultup    = 1;
                cup->utrunc     = 0;
        }
/*
 *      Detect some cases of the file not being a disk file.
 */
        if (statp_valid && ! S_ISREG(statp->st_mode))
                disk_file       = 0;    /* file exists and isn't a regular file */

/*
 *      Now we check for specifications which are mapped to FFIO.
 */
        ffio_layer      = NULL;

        for (i = 0; i < FPARMAX; i++)
                num[i]  = -1;           /* assume we'll use layer defaults */


        switch (tufs) {

/*
 *      Map '-s sbin' to '-s text' for formatted opens.
 */
        case STD:
                if (cup->ufmt) {
                        errno   = FEOPNFMT;     /* Can't open FORMATTED */
                        return(-1);
                }
                break;
/*
 *      Map '-s text' to '-F text' if doing implicit data conversion.
 */
        case FS_TEXT:
                if (cup->ufmt && cup->useq && cup->ucharset)
                        ffio_layer      = "text";
                break;
/*
 *      Map '-s u' to '-F syscall -T off'
 *      Map '-s u -a SDS -n xx'     to '-F sds.scr.novfl:xx:xx:0 -T off'
 */
        case FS_U:
                if (! (aifound && aip->T_utrunc_flg))
                        cup->utrunc     = 0; /* no trunc by default with -s U */

                opt_flags       = O_RAW;

                if (aifound && aip->a_sdsfil_flg) {     /* '-a SDS' requested */
                        register int    presize;

                        if (aip->n_preall_flg)
                                presize = aip->n_preall;
                        else {          /* SDS allocation failure */
                                errno   = FESDSFSS;
                                return(-1);
                        }
                
                        ffio_layer      = "sds.scr.novfl";
                        num[0]          = presize;
                        num[1]          = presize;
                        num[2]          = 0;
                }
                else
                        ffio_layer      = "syscall";
                break;

/*
 *      Map f77 blocking with -b xx to '-F f77::(xx*BLKSIZE)'
 */
        case FS_F77:
                ffio_layer      = "f77";
                if (aifound && aip->b_bufsiz_flg)
                        num[1]  = aip->b_bufsiz * BLKSIZE;
                break;

/*
 *      Map '-s COS -b xx' to '-F cos:xx'
 */
        case FS_COS:
                ffio_layer      = "cos";
                if (aifound && aip->b_bufsiz_flg)
                        num[0]  = aip->b_bufsiz;
                break;


#if     !defined(_UNICOS) && !defined(__mips) && !defined(_LITTLE_ENDIAN)
/*
 *      Map '-s unblocked'            to '-s sbin'         on non-UNICOS systems
 *      Map '-s bin'                  to '-s sbin -T off'  on non-UNICOS systems
 */
        case FS_UNBLOCKED:
        case FS_BIN:
                if (tufs == FS_BIN) {
                        if (! (aifound && aip->T_utrunc_flg))
                                cup->utrunc     = 0; 
                }
                /*
                 * The only buffering scheme available on Sparc for unblocked
                 * files is stdio, so we use it.
                 */
                tufs    = STD;                  
                break;
#endif  /* !_UNICOS && !__mips && !_LITTLE_ENDIAN */

#if     defined(_UNICOS) || defined(__mips) || defined(_LITTLE_ENDIAN)
/*
 *      Map '-s unblocked'             to '-s sbin'         for non-disk files
 *      Map '-s unblocked -b bs'       to '-F bufa:bs'      for seq disk files on Unicos
 *      Map '-s unblocked -b bs'       to '-s sbin'         for seq disk files on MIPS
 *      Map '-s unblocked -b bs -u nb' to '-F cachea:bs:nb' for direct acc files
 *
 *      Map '-s bin' to the same, plus set "-T off" by default.
 *
 *      Map unformatted FORM='SYSTEM' and FORM='BINARY' to -s unblocked.
 *      There are no record control images for these two forms.
 */
        case FS_UNBLOCKED:
        case FS_BIN:
                if (!disk_file) {
                        tufs    = STD;          /* ttys and pipes use stdio */
                        break;
                }

                if (cup->useq) {                /* If sequential access file */
                        ffio_layer      = "bufa";
                        num[0]          = SUBUFSZ;      
                }
                else {
#if     defined(__mips) || defined(_LITTLE_ENDIAN)
                        ffio_layer      = "cache";
#else
                        ffio_layer      = "cachea";
#endif
                        num[0]          = DUBUFSZ;      
                }

                if (tufs == FS_BIN) {
                        if (! (aifound && aip->T_utrunc_flg))
                                cup->utrunc     = 0; 
                        num[0]  = DEF_BIN_BS;   
                }

#ifdef  _UNICOS_MAX
                if (_MPP_MPPSIM > 0) {
                        /*
                         * Running on simulator in user virtual mode. 
                         * Simulator cannot handle large reads/writes, 
                         * so adjust the default buffer size smaller.
                         */
                        num[0]  = _VALUE(_def_cch_simbufsiz);
                }
#endif
#if     !defined(__mips) && !defined(_LITTLE_ENDIAN)
                /*
                 * If the user has not requested a buffer size
                 * with assign, ensure that the buffer size is
                 * at least as large as the record size up to
                 * a "reasonable" limit.  At some point, the
                 * user must take responsibility for assigning
                 * lots of memory to I/O buffers.
                 */

                if (!cup->useq && default_ftype &&
                    (DUBUFSZ * BLKSIZE) < cup->urecl) {
                        register int    bsize;

                        bsize   = (cup->urecl + (BLKSIZE - 1)) / BLKSIZE;

                        if (bsize > 100)
                                bsize   = 100;

                        num[0]  = bsize;
                }

#endif

                if (aifound && aip->b_bufsiz_flg)
                        num[0]  = aip->b_bufsiz;

                if (aifound && aip->u_bufcnt_flg)
                        num[1]  = aip->u_bufcnt;

                break;
#endif  /* _UNICOS || __mips || _LITTLE_ENDIAN */

#ifdef  _UNICOS
/*
 *      Map '-s [bmx, tape, tape50, bmx50] -b bs -u nm' to '-F tape:bs:nm' 
 */
        case FS_TAPE:
                cup->ubmx       = 1;    /* Indicate that '-s tape' or '-s bmx'
                                 * was selected by the user. */

        case FS_TAPE50:         /* Fall-through! */

                ffio_layer      = "tape";

                if (aifound && aip->b_bufsiz_flg)
                        num[0]  = aip->b_bufsiz;

                if (aifound && aip->u_bufcnt_flg)
                        num[1]  = aip->u_bufcnt;
                break;
#endif  /* _UNICOS */
        }       /* end switch(tufs) */

        if (tufs == FS_FDC)
                fdspec  = &aip->F_filter[0];
        else if (ffio_layer != NULL) {
                fdspec  = specspace;
                make_fdspec(fdspec, ffio_layer, num);
                tufs    = FS_FDC;
        }

/*
 *      Only the FS_FDC paths through _frwd/_fwwd/_frch/_fwch handle 
 *      data conversion.
 */
        if (tufs != FS_FDC &&
            (!cup->ufmt && cup->unumcvrt || (cup->ufmt && cup->ucharset))) {
                errno   = FENOICNV;
                return(-1);
        }

/*
 *      Open the file with permissions dictated by the ACTION= specifier and
 *      the system file permissions.  When ACTION= is unspecified on the open,
 *      try read/write, read-only, and write-only.
 *
 *      When ACTION='WRITE' is specified, try read/write and write-only if the
 *      file is a disk file.  Read permission may be needed for support of
 *      backspace and read-before-write buffer caching.  If the file is not a
 *      disk file, open as write-only since backspace and read-before-write
 *      caching support are not needed.
 */
        if (cup->uaction == OS_READWRITE ||
           (cup->uaction == OS_WRITE && disk_file) ||
            cup->uaction == OS_ACTION_UNSPECIFIED) {

                flags   = O_RDWR | o_sysflgs | opt_flags;

                if (_do_open(cup, css, tufs, actnam, flags, aifound, aip,
                        fdspec, catcherr) == 0)
                        not_open        = 0;
        }

        if (not_open &&
            (cup->uaction == OS_READ ||
             cup->uaction == OS_ACTION_UNSPECIFIED)) {

                flags   = O_RDONLY | o_sysflgs | opt_flags;

                if (_do_open(cup, css, tufs, actnam, flags, aifound, aip,
                        fdspec, catcherr) == 0)
                        not_open        = 0;
#if     defined(__mips) || defined(_LITTLE_ENDIAN)
                else {
                /*
                 * There is a bug in NFS for IRIX 6.2 through 6.5 systems
                 * whereby an open with O_RDONLY|O_CREAT aborted if the
                 * process only had read-only access to an existing file.
                 * The O_CREAT is supposed to be ignored if the file
                 * already exists, but that wasn't happening.  To work
                 * around this bug, we remove the O_CREAT flag and retry
                 * the open.  Someday, when these systems are no longer
                 * supported, this code can be removed.
                 */
                        flags   = flags & ~O_CREAT;     /* Remove O_CREAT bit */

                        if (_do_open(cup, css, tufs, actnam, flags, aifound,
                                        aip, fdspec, catcherr) == 0)
                                not_open        = 0;
                }
#endif
        }

        if (not_open &&
            (cup->uaction == OS_WRITE ||
             cup->uaction == OS_ACTION_UNSPECIFIED)) {

                flags   = O_WRONLY | o_sysflgs | opt_flags;

                if (_do_open(cup, css, tufs, actnam, flags, aifound, aip,
                        fdspec, catcherr) == 0)
                        not_open        = 0;
        }

        if (not_open) {
                /*
                 * Replace error code EACCES with FEFILACT only when
                 * ACTION= was specified on OPEN.
                 */
                if (cup->uaction != OS_ACTION_UNSPECIFIED && errno == EACCES)
                        errno   = FEFILACT; /* invalid ACTION for this file */
                return(-1);
        }

        acc_mode        = flags & O_ACCMODE;
        cup->usysread   = (acc_mode == O_RDONLY || acc_mode == O_RDWR);
        cup->usyswrite  = (acc_mode == O_WRONLY || acc_mode == O_RDWR);

/*
 *      Be sure to set uaction if ACTION= was not specified on the OPEN.
 */
        if (cup->uaction == OS_ACTION_UNSPECIFIED)
                cup->uaction    = cup->uaction |
                                  (cup->usysread  ? OS_READ  : 0) |
                                  (cup->usyswrite ? OS_WRITE : 0);

/*
 *      Set cup->ufs to indicate that the underlying open has succeeded.
 */
        cup->ufs        = tufs;

/*
 *      Tape file setup for the assign -d option.
 */
        if (aifound && aip->d_datrcv_flg) {
                register int    ret;

                if (tufs != FS_FDC) {
                        errno   = FENOSKPB;
                        return(-1);
                }
#if     !defined(__mips) && !defined(_LITTLE_ENDIAN)
                ret     = XRCALL(cup->ufp.fdc, fcntlrtn) cup->ufp.fdc, FC_AUTOBAD,
                        ((aip->d_datrcv == AS_SKIPBAD) ? AUTO_SKIP : AUTO_ACPT),
                         &cup->uffsw);

                if (ret < 0) {
                        errno   = cup->uffsw.sw_error;
                        return(-1);
                }
#else
                return(-1);
#endif
        }

/*
 *      Initialize the asynchronous status structure. This word is
 *      passed a little differently for async and for synchronous I/O.
 *      The WAITIO macro is called anytime an outstanding request could
 *      be pending, and appropriate processing done to ensure that the
 *      the status field is set in the ffsw.
 */
        FFSTAT(cup->uffsw)      = FFBOD;        /* at beginning of data */
        cup->uffsw.sw_error     = 0;
        cup->uffsw.sw_count     = 0;

/*
 *      Set cf77, cf90, irixf77, or irixf90 mode.  Retain uft90 for
 *      simple tests between f77 and f90.  Use the ufcompat for other
 *      differences.
 */

        cup->ufcompat   = 0;

        if ( aifound && aip->f_fortst_flg ) {
                (cup->uft90     = (aip->f_fortst == AS_FORTRAN90) ? 1 :
                (cup->uft90     = (aip->f_fortst == AS_IRIX_F90) ? 1 : 0));
                cup->ufcompat   = aip->f_fortst;
        }

        if ( aifound && aip->t_tmpfil_flg ) {
                cup->uscrtch    = 1;
                cup->utmpfil    = 1;
        }

/*
 *      Set up list-directed output format for MPP, PVP, and IRIX
 *      systems.  Set the global values first.  Allow individual
 *      flags to override the global flag.  Note that default is
 *      the same for all systems except for the namelist skip.
 *      Also set the default for writing -0.0 for formatted io.
 */
        cup->ufunilist  = 0;
        cup->ufcomsep   = 0;
        cup->ufcomplen  = 0;
        cup->ufrptcnt   = 0;
#if     !defined(__mips) && !defined(_LITTLE_ENDIAN)
        cup->ufnl_skip  = 0;
        cup->ufnegzero  = 0;
#else
        cup->ufnl_skip  = 1;
        cup->ufnegzero  = 1;
#endif
        
/*
 *      If the global list-directed output flag is set for UNICOS,
 *      set the individual flags to the same value as the global
 *      flag.
 */
        if ( aifound && aip->U_unicoslist_flg ) {
                cup->ufunilist  = aip->U_unicoslist;
                cup->ufcomsep   = aip->U_unicoslist;
                cup->ufcomplen  = aip->U_unicoslist;
                cup->ufrptcnt   = aip->U_unicoslist;
        } else if (aifound && aip->f_fortst == AS_IRIX_F77) {
/*
 *      If the global list-directed output flag is not set and
 *      the f irixf77 option is specified, set the individual
 *      individual flags to the MIPS f77 default values.
 */
                cup->ufunilist  = 1;
                cup->ufcomsep   = 1;
                cup->ufcomplen  = 1;
                cup->ufrptcnt   = 1;
        }

/*      Override the global list-directed output settings if
 *      individual flags are set.
 */
        if ( aifound && aip->S_comsep_flg ) {
                cup->ufcomsep   = aip->S_comsep;
        }

        if ( aifound && aip->W_compwidth_flg ) {
                cup->ufcomplen  = aip->W_compwidth;
        }

        if ( aifound && aip->y_reptcnt_flg ) {
                cup->ufrptcnt   = aip->y_reptcnt;
        }

/*
 *      Override global setting for writing -0.0 in formatted io.
 *      Default setting for irix: Do not write minus sign for -0.0.
 *      Default setting for all PVP,ieee platforms: Write minus sign
 *      for -0.0.
 */
        if ( aifound && aip->Z_neg_zero_flg ) {
                cup->ufnegzero  = aip->Z_neg_zero;
        }

/*
 *      Set up namelist input behavior for MPP, PVP, IRIX systems
 *      when cilist namelist group name does not match the group
 *      name provided in the namelist input record.  The default
 *      is to error on UNICOS and UNICOS/mk and to skip on IRIX.
 */
        if ( aifound && aip->Y_nl_skip_flg ) {
                cup->ufnl_skip  = aip->Y_nl_skip;
        }

/*
 *      Set cup->ublkd and fd in a variety of ways.
 */
        switch( cup->ufs ) {
        register int    ret;

        case FS_TEXT:
                fd      = fileno ( cup->ufp.std );
                if (cup->ufmt == 0) {
                        errno   = FEOPNUNF; /* Can't open UNFORMATTED */
                        return(-1);
                }
                cup->ublkd      = 1;
                break;

        case STD:
                fd      = fileno ( cup->ufp.std );
                if (cup->ufmt)
                        cup->ublkd      = 1;    /* no stdio blocking if formatted */
                else
                        cup->ublkd      = 0;    /* no stdio blocking if unformtd */
                break;

        case FS_FDC:
/*
 *              Get file descriptor and other info for FDC files
 */
                ret     = XRCALL(cup->ufp.fdc, fcntlrtn) cup->ufp.fdc,
                                FC_GETINFO, &info, &ffiostat);
                if (ret < 0) {
                        errno   = ffiostat.sw_error;
                        return(-1);
                }

                cup->uflagword  = info.ffc_flags;

/*
 *              Get stat information.
 */
                ret     = XRCALL(cup->ufp.fdc, fcntlrtn) cup->ufp.fdc,
                                FC_STAT, &ffio_statbuf, &ffiostat);
                if (ret < 0) {
                        errno   = ffiostat.sw_error;
                        return(-1);
                }

                _ffconvert_stat(&ffio_statbuf, statp);
                statp_valid     = 1;

/*
 *              Indicate whether the file knows about EOR
 */
                cup->ublkd      = ((cup->uflagword & FFC_REC) ? 1 : 0);
/*
 *              Indicate whether the file permits multiple endfile records.
 *              Assume that a file has a physical endfile representation if
 *              and only if multiple endfile records are permitted.
 */
                cup->umultfil   = ((cup->uflagword & FFC_WEOF) ? 1 : 0);

                if (cup->ufmt) {
                        /*
                         * Formatted files must be capable of handling text.
                         */
                        if ((info.ffc_flags & FFC_CODED) == 0) {
                                errno   = FEOPNFMT; /* Can't open FORMATTED */
                                return(-1);
                        }
                        /*
                         * Sequential formatted files must have a record 
                         * structure.
                         */
                        if (cup->useq && (info.ffc_flags & FFC_REC) == 0) {
                                errno   = FEOPNFMT; /* Can't open FORMATTED */
                                return(-1);
                        }
                }
                else {
                        /*
                         * Unformatted files must be capable of handling 
                         * binary data.
                         */
                        if ((info.ffc_flags & FFC_BINARY) == 0) {
                                errno   = FEOPNUNF; /* Can't open UNFORMATTED */
                                return(-1);
                        }
                }
/*
 *              Make sure the capabilities are right to do DA, if requested.
 */
                if (cup->useq == 0) {   /* If direct access */
/*
 *                      If layer has a fixed record length, make sure it
 *                      matches the REC= on the OPEN.
 */
                        if (info.ffc_reclen != 0) {
                                if (info.ffc_reclen != (cup->urecl << 3)) {
                                        /* reclen does not match file */
                                        errno   = FEOPIVRL;
                                        return(-1);
                                }
                        }
/*
 *                      If not fixed length records, it better be stream.
 *                      If not, (variable length recs?) blow the user off.
 */
                        else if ((cup->uflagword & FFC_STRM) == 0) {
                                errno   = FEOPNNDA;
                                return(-1);
                        }
                }
/*
 *              Make sure that user-requested suppression of truncation after
 *              write is supported by the top FFIO layer.
 */
                if (cup->useq && aifound && aip->T_utrunc_flg &&
                    aip->T_utrunc == 0 &&
                    (info.ffc_flags & FFC_WRTRUNC)) {

                        errno   = FERQTRNC;     /* must trunc after write */
                        return(-1);
                }

                fd      = info.ffc_fd;
                break;

        default:
                errno   = FEINTFST;
                return(-1);
        }

        cup->usysfd     = fd;

/*
 *      From this point on, the stat buffer pointed to by statp will be valid 
 *      for ALL files.
 */
        if (! statp_valid && fstat(fd, statp) == -1)
                return(-1);
        statp_valid     = 1;

/*
 *      The useek field is used only for STD files.
 */
        if (fd != -1) {
                if ((S_ISREG(statp->st_mode) && !isatty(fd)) || 
                    _gsys_qtape(statp))
                        cup->useek      = YES;
                else
                        cup->useek      = NO;
        }

#ifdef  _UNICOS
/*
 *      Do preallocation as specified by -n/-p/-q
 */
        if (fd != -1) {
                if (_prealloc(fd, aifound, aip, statp) == -1)
                        return(-1);
        }
#endif

/*
 *      See if asynchronous I/O is OK.
 *      Asynchronous I/O is only allowed if no data conversion is active and
 *      some form of FFIO is being used.  All FFIO should have an async
 *      entry, even though it may not *actually* be asynchronous.
 */
        cup->uasync     = ASYNC_NOTOK;  /* assume that async is NOT OK. */

        if ((cup->unumcvrt | cup->ucharset) == 0 && cup->ufs == FS_FDC) {
                cup->uasync     = ASYNC_OK;     /* async I/O is OK */
        }

/*
 *      Set up the udamax field.  This is the 1-based maximum record number 
 *      for direct access files.
 */
        if (cup->useq == 0) {   /* If direct access */
                long    recl;
                recl    = cup->urecl;
                if (cup->ufmt && cup->ufs != FS_FDC)
                        recl++;
                /* allow the last record to be shorter than recl */
                cup->udamax     = (statp->st_size + recl - 1) / recl;
        }

        return(0);
}

/*
 *      make_fdspec     - assembles the fdspec which can be passed to _ffopen
 *
 *      Return value 
 *              Always returns 0.
 */
static int
make_fdspec(
        union spec_u    *fdspec,                /* output - receives the fdspec */
        char            *layer,                 /* the layer name */
        int             num[FPARMAX])           /* the numeric parameters; -1 
                                                 * indicates no parameter */
{
        register short  i;
        register int    ret;
        char    buf[FPARMAX][30];       /* each must be big enough for MAXINT */
        char    ffio_str[20+FPARMAX*30];/* holds layer string and up to 3 
                                         * integers */

        for (i = 0; i < FPARMAX; i++) {
                if (num[i] == -1) 
                        buf[i][0]       = '\0'; /* empty string */
                else
                        sprintf(buf[i], "%d", num[i]);
        }

        /* Assume FPARMAX is <= 3 */

        (void) sprintf(ffio_str, "%s:%s:%s:%s", layer, buf[0], buf[1], buf[2]);

        ret     = _parse_forstr(fdspec, ffio_str, SPECSZ, 0, _LELVL_RETURN);

        if (ret < 0)
                _ferr(NULL, FEINTUNK);          /* shouldn't happen */

        return(0);
}

/*
 *      According to the file structure make the appropriate call to
 *      open the file.  Open routines are file structure dependent.
 *
 *      Return value is 0 on success, -1 on error with errno set.
 *
 *      If catcherr == 0, some errors will abort here.  Others do not cause
 *      an abort because _do_open might be retried with different permissions.
 */
int
_do_open(
unit            *cup,
FIOSPTR         css,
int             tufs,
char            *actnam,
int             flags,
int             aifound,
assign_info     *aip,
union spec_u    *fdspec,
int             catcherr)
{
        long            bs;
        register int    cbits;
        register int    cblks;
        register int    i;
        long            asave[(AFLAGSIZE + sizeof(long)) / sizeof(long)];
        char            *flagstr;
        char            *attrstr;
        struct  ffsw    ffiostat;
        struct gl_o_inf gloinf;
        _ffopen_t       otmp;

        (void) memset(&gloinf, 0, sizeof(gloinf));

        gloinf.open_type        = OT_FORTRAN;
        gloinf.aip              = aifound ? aip : NULL;
        gloinf.u.fort.unum      = cup->uid;
        gloinf.u.fort.is_seq    = cup->useq;
        gloinf.u.fort.is_fmt    = cup->ufmt;
        gloinf.u.fort.reclen    = cup->urecl;

        cbits   = 0;
        cblks   = 0;

/*
 *      Handle -B, -r, -x, -w,-L, and -l assign options.
 */
        if (aifound) 
                _ae_setoflags(aip, &flags);

#ifdef  _UNICOS
/*
 *      Handle -p and -q assign options.
 */
        if (aifound && aip->pr_partit_flg) {
                flags   = flags | O_PLACE;
                cbits   = aip->pr_partit;
        }

        if (aifound && (aip->n_stride_flg || aip->q_ocblks_flg)) {
                flags   = flags | O_PLACE;
 
                if (aip->q_ocblks_flg)
                        cblks   = aip->q_ocblks;
                else
                        cblks   = aip->n_stride;
        }
#endif  /* _UNICOS */

        switch ( tufs ) {

        case FS_TEXT:
        case STD:

/*
 *              If this is a standard file which is already open, skip
 *              the open system call, but validate the flags.
 */
                if (cup->ufp.std != NULL) {
                        register int    fdflags;

#if     !defined(_LITTLE_ENDIAN) || (defined(_LITTLE_ENDIAN) && defined(__sv2))
                        if (cup->ufp.std->_flag & _IORW)
                                fdflags = O_RDWR;
                        else if (cup->ufp.std->_flag & _IOWRT)
                                fdflags = O_WRONLY;
                        else
                                fdflags = O_RDONLY;

                        if ((fdflags & O_ACCMODE) != (flags & O_ACCMODE)) {
                                errno   = EACCES;
                                return(-1);
                        }
#endif
                }
                else {

#ifdef  _UNICOS 
                        /*
                         * _stdio_open is a duplicate name for open() 
                         * It is used ONLY by code in libc/stdio and here, 
                         * because this is nearly equivalent to an 
                         * "fopen". _stdio_open is used so that the opens 
                         * from these routines will be unique. It was 
                         * requested by marketing.
                         */
#ifndef _CRAYMPP
                        i       = _stdio_open(
#else
                        i       = open(
#endif
                                actnam, flags, ACCESS_PERMS, cbits, cblks);
#else   /* ! _UNICOS */
                        i       = open( actnam, flags, ACCESS_PERMS);
#endif  /* ! _UNICOS */
                        if (i < 0)
                                return(-1);

                        if ((flags & O_ACCMODE) == O_RDWR)
                                flagstr = "r+";
                        else if ((flags & O_ACCMODE) == O_WRONLY) {
                                if (flags & O_APPEND)
                                        flagstr = "a";
                                else
                                        flagstr = "w";
                        }
                        else 
                                flagstr = "r";

                        MEM_LOCK(&_ioblock);    /* Lock libf access to iob table*/

                        cup->ufp.std    = fdopen(i, flagstr);

                        MEM_UNLOCK(&_ioblock);  /* Unlock iob table */

                        if (cup->ufp.std == NULL)
                                return(-1);
                }

/*
 *              Set up buffer size.  If file is direct access, then there
 *              is no advantage in having a buffer size larger than the
 *              record size because stdio ends up flushing each record
 *              anyway.  For formatted I/O, add one byte for the newline.
 *              Finally, ensure than the buffer size is at least two words.
 */
                bs      = DEF_SBIN_BS * BLKSIZE;        /* Set default size */

#ifdef  _UNICOS_MAX
                /*
                 * If running on simulator in user virtual mode, restrict
                 * the since since the simulation cannot handle large reads
                 * and writes.
                 */
                if (_MPP_MPPSIM > 0)
                        bs      = DEF_SBINSIM_BS * BLKSIZE;
#endif

                if (aifound && aip->b_bufsiz_flg)
                        bs      = aip->b_bufsiz * BLKSIZE;
                else
                        if (cup->useq == 0 && cup->urecl < bs) {
                                bs      = cup->urecl + (cup->ufmt ? 1 : 0);
                                if (bs < 16)
                                        bs      = 16;
                        }

/*
 *              We may only call setvbuf if the file has seen no read/write
 *              activity.  The buffer will not be allocated unless there
 *              have been reads or writes.  This check is necessary for
 *              standard files.
 *
 *              We do not allow DEF_SBIN_BS or the -b option to override 
 *              the _IONBF buffering mode for stderr or _IOLBF buffering
 *              for tty files.  In both cases, stdio picks appropriate
 *              buffer sizes.
 */
#if     defined(_LITTLE_ENDIAN) && !defined(__sv2)
                if (cup->ufp.std->_IO_buf_base == NULL &&
                    fileno(cup->ufp.std) != STDERR_FILENO &&
                    ! isatty(fileno(cup->ufp.std)))
                        (void) setvbuf(cup->ufp.std, NULL, _IOFBF, bs);
#else
                if (cup->ufp.std->_base == NULL &&
                    fileno(cup->ufp.std) != STDERR_FILENO &&
                    ! isatty(fileno(cup->ufp.std)))

                        (void) setvbuf(cup->ufp.std, NULL, _IOFBF, bs);
#endif

                break;                  /* DONE */

        case FS_FDC:

#ifdef  _UNICOS
/*
 *              Set the raw bit.  It is unlikely to hurt, and will
 *              frequently help performance.
 */
                flags   = flags | O_RAW;
#endif
                if (aifound)
                        _attr_copy(aip, (assign_info *)&asave);

                otmp    = _ffopen(actnam, flags, ACCESS_PERMS, fdspec,
                                &ffiostat, cbits, cblks, NULL, &gloinf);
                if (otmp == _FFOPEN_ERR) {
                        /*
                         * Restore the ATTR_USED flags in case _do_open
                         * is called in a retry.
                         */
                        if (aifound)
                                _attr_copy((assign_info *)&asave, aip);

                        errno   = ffiostat.sw_error;
                        return(-1);
                }

                cup->ufp.fdc    = (struct fdinfo *) otmp;
                cup->useek      = YES;
                attrstr         = NULL;

                if (aifound && _attr_used(aip, &attrstr) == -1) {
                        if (catcherr == 0) 
                                _ferr(css, errno, attrstr);
                        return(-1);
                }

                break;

        default:
                errno   = FEINTFST;
                return(-1);

        }
        return(0);
}

/*
 *      This function converts an "ffc_stat_s" structure to a "stat" structure.
 *      Currently, these structures are identical.  If they ever diverge,
 *      this function would call sysconf() or in some other way detect which
 *      version of struct stat was being used.  Then the ffc_stat_s structure
 *      would be translated into the stat structure.
 */ 
void
_ffconvert_stat(struct ffc_stat_s *src, struct stat *dest)
{
        assert ( sizeof(*src) == sizeof(*dest) );

        *dest   = *(struct stat *)src;

        return;
}