frwd.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/frwd.c     92.3    09/29/99 19:50:24"

#include <errno.h>
#include <fortran.h>
#include <liberrno.h>
#ifdef  _ABSOFT
#include <stdlib.h>
#endif
#include <cray/nassert.h>
#include "fio.h"

#include <stdlib.h>

#define TBFSZ   (4096 * sizeof(long))   /* Size of temporary buffer (bytes) */

static const _f_int     bitoff = 0;
static const _f_int     stride = 1;

/*
 *      _frwd 
 *              Read binary data from one record of a Fortran file.
 *
 *      Side effects
 *
 *              Increments cup->urecpos by the change in bit position within
 *              the record, including pad bits.
 *
 *              Sets *status as follows:
 *
 *                      CNT - if the requested number of items were read, and
 *                            more data remains in the current record (if
 *                            the file has records).  
 *                      EOR - if all remaining data in the current record was 
 *                            read by this request. 
 *                      EOF - if a physical EOF mark was read and no data 
 *                            preceded the EOF mark.
 *                      EOD - if the end-of-data mark was reached and no data 
 *                            was read.
 *
 *      Return value
 *              The number of items read.  -1 on error with errno set to
 *              the error code.
 *
 *      Note
 *              If a nonzero amount of data was read and an EOF mark or the 
 *              end of file was encountered before reading the full amount
 *              of data requested and before encountering EOR, CNT status is 
 *              returned.  This is not well supported because we never detect 
 *              that we processed the EOF.  However, no FFIO layers currently 
 *              support embedded EOF marks inside a record.
 */

long
_frwd(
unit            *cup,           /* Unit pointer */
void            *uda,           /* User data address */
type_packet     *tip,           /* Type information packet */
int             mode,           /* FULL or PARTIAL record mode */
int             *ubcret,        /* If non-NULL, pointer to unused bit count in 
                                 * the last item.  This is both an input and 
                                 * output parameter.  On input it enables the 
                                 * caller to request an arbitrary number of 
                                 * bits.  On output it reflects the actual data
                                 * transfer.
                                 *  NOTE:  Normal item alignment (normally 
                                 *         forced to word boundaries) is 
                                 *         disabled when this parameter is 
                                 *         passed.      */
long            *wr,            /* If non-NULL, pointer to number of items read.
                                 * This is an output parameter.  It is useful 
                                 * because it is possible to have an error 
                                 * return, but still return data.  This 
                                 * parameter is set only if an error is 
                                 * encountered with data being delivered.  It 
                                 * is currently only set for FFIO files where 
                                 * foreign data conversion is not active. */
int             *status)        /* assigned on return to CNT, EOR, EOF, or EOD*/
{
        register int    fdsize;         /* Item size (bits) in file */
        register int    padbyts;
        register long   elsize;
        register long   items;
        register ftype_t type;          /* Fortran data type */
        register size_t breq;
        register ssize_t ret;
        register int64  totbits;
        int             padubc;
        int             ubc;
        _f_int          icount;

        /* Assertions */

#ifdef  _UNICOS
        assert ( _numargs() == 7 );
#endif
        assert ( mode == FULL || mode == PARTIAL );
        assert ( tip != NULL );
        assert ( status != NULL );

        type    = tip->type90;
        elsize  = tip->elsize;
        items   = tip->count;
        breq    = elsize * items;       /* bytes requested */
        padbyts = 0;
        padubc  = 0;
        ubc     = 0;
/*
 *      If a ubc word is passed, this call is asking for typeless data; no 
 *      data conversion will be done.  The ubcret and wr arguments are used
 *      by CALL READ/READP.
 */
        if (ubcret != NULL) {
                if ((*ubcret & 7) != 0 && cup->ufs != FS_FDC) {
                        errno   = FEUBCINV;
                        return(IOERR);
                }
                if (type != DVTYPE_TYPELESS) {
                        errno   = FEINTUNK;
                        return(IOERR);
                }
/*
 *              Adjust breq for ubc input, which can be 0-63
 */
                breq    -= *ubcret >> 3;
                ubc     = *ubcret & 7;
        }
#if     NUMERIC_DATA_CONVERSION_ENABLED
        else {
/*
 *              Pad word-aligned numeric data on word boundaries within
 *              the record for CRI and some foreign data formats.  Note
 *              that the elsize expression needs to be cleaned up to be
 *              something like:  external_size > granularity.
 */
                if ((cup->urecpos & cup->ualignmask) != 0 &&
                    type != DVTYPE_ASCII &&
                    items > 0 &&
#if     defined(__mips) || defined(_LITTLE_ENDIAN)
                    elsize > 2 ) {
#else
                    elsize > 4 ) {
#endif

                        long    blanks;
                        COMPADD(cup, padbyts, padubc, blanks);
                }
        }
#endif  /* NUMERIC_DATA_CONVERSION_ENABLED */

        cup->ulastyp    = type;

        *status = CNT;          /* default return status */
/*
 *      According to the file structure make the appropriate
 *      low level read request.
 */
        switch ( cup->ufs ) {

        case  STD:
/*
 *              If the number of items to read is zero return to caller. 
 *              Unicos binary files have no record structure.  Except for
 *              an end of file, a read request always returns CNT status.
 */
                if (items == 0)
                        return(0);

                ret     = 1;

                if (padbyts > 0) {      /* Flush a few bytes */
                        int     dummy;

                        ret     = fread(&dummy, 1, padbyts, cup->ufp.std);

                        if (ret > 0)
                                cup->urecpos    += (uint64)ret << 3;

                }
                if (ret > 0)    /* don't continue if last read failed. */
                        ret     = fread(uda, 1, breq, cup->ufp.std );
 
                if (ret == 0) {
                        if ( ferror(cup->ufp.std) ) {
                                if (errno == 0)
                                        errno   = FESTIOER;
                                return(IOERR);
                        }
                        *status = EOD;
                        return(0);
                }
/*
 *              If the read produced an integral number of items, return.
 *              else allow partial items only for typeless.
 */
                icount          = ret / elsize;
                cup->urecpos    = cup->urecpos + (uint64) (ret << 3);

                if ((ret % elsize) != 0)
                        if (type == DVTYPE_TYPELESS) {

                                icount  = icount + 1;

                                if (ubcret != NULL)
                                        *ubcret = (elsize - (ret % elsize)) << 3;
                        }
                        else
                                if (icount == 0) {
                                        errno   = FERDPEOR;
                                        return(IOERR);
                                }

                break;

        case FS_FDC:
/*
 *              Align the FD to a word boundary if required.
 */

                if (padbyts > 0) {
                        long    paddval;

                        ret     = XRCALL(cup->ufp.fdc, readrtn) cup->ufp.fdc,
                                CPTR2BP(&paddval), padbyts, &cup->uffsw,
                                PARTIAL, &padubc);

                        if (ret != padbyts || FFSTAT(cup->uffsw) != FFCNT) {

                                if (ret < 0) {
                                        errno   = cup->uffsw.sw_error;
                                        return(IOERR);
                                }

                                *status = FF2FTNST(FFSTAT(cup->uffsw));

                                return(0);
                        }

                        cup->urecpos    += ((uint64)ret << 3) - padubc;
                }
/*
 *              If no conversion to be done, just read in the data
 */
                if (tip->cnvindx == 0) {
                        register short  erret;
/*
 *                      read in the data
 */
                        ret     = XRCALL(cup->ufp.fdc, readrtn) cup->ufp.fdc,
                                        CPTR2BP(uda), breq,
                                        &cup->uffsw, mode, &ubc);

                        *status = FF2FTNST(FFSTAT(cup->uffsw));
                        erret   = 0;

                        if (*status == EOR)
                                cup->ulastyp    = DVTYPE_TYPELESS;

                        if (ret < 0) {          /* if an error */

                                errno   = cup->uffsw.sw_error;

                                if (errno == FETAPUTE) {
                                        ret     = cup->uffsw.sw_count;
                                        erret   = 1;
                                }
                                else
                                        return(IOERR);
                        }
                        else
                                if (ret == 0)
                                        return(0);
/*
 *                      Data was returned (ret > 0), process it
 *
 *                      If the read produced an integral number of items,
 *                      then return.  Else allow partial items only for
 *                      typeless.
 */
                        totbits         = ((uint64)ret << 3) - ubc;
                        cup->urecpos    = cup->urecpos + totbits;
                        icount          = totbits / (elsize << 3);

                        if (type == DVTYPE_TYPELESS) {

                                if ((((uint64)icount*elsize) << 3) != totbits) {

                                        icount  = icount + 1;

                                        if (ubcret != NULL)
                                                *ubcret = (elsize << 3) -
                                                   (totbits % (elsize << 3));
                                }

                                if (wr != NULL)
                                        *wr     = icount;
                        }
                        else
                                if (icount == 0) {
                                        errno   = FERDPEOR;
                                        erret   = 1;
                                }

                        if (erret == 1)
                                return(IOERR);

                        goto done;      /* Return number of items read */
                }

#if     NUMERIC_DATA_CONVERSION_ENABLED
/*
 *              Process numeric or character conversion.
 */
                {
                int             (* cvt_fun)();  /* Conversion function  */
                _f_int          dctype;
                char            tbuf[TBFSZ];    /* Temporary buffer     */
                char            *bptr;          /* Buffer pointer       */

                cvt_fun = __fndc_ncfunc[tip->cnvindx].to_native;

#if     !defined(__mips) && !defined(_LITTLE_ENDIAN)
                if (!_loaded(cvt_fun)) {
                        errno   = FELDDCNV;
                        return(IOERR);
                }
#endif

                fdsize  = tip->extlen;
                dctype  = tip->cnvtype;

/*
 *              Point the pointer to the tail end of the buffer by
 *              calculating the total bit count, and then rounding down
 *              to a word boundary.  Note that fdsize is the size of
 *              each byte for type==DVTYPE_ASCII, so we must multiply by
 *              elsize to get the real total bit count.
 */
                if (fdsize == 0) {
                        errno   = FDC_ERR_NCVRT;
                        return(IOERR);
                }

                totbits = items * fdsize;       /* Bit size of foreign data to 
                                                 * be read from the file. */

                if (type == DVTYPE_ASCII)
                        totbits = totbits * tip->elsize;

                if (ubcret != NULL)
                        totbits = totbits - *ubcret;

                /*
                 * Round pointer down to the next byte if numeric conversion
                 * is requested.
                 */

                bptr    = tbuf; /* Assume data will fit in temporary buffer */
                breq    = (totbits + 7) >> 3;
                ubc     = ((uint64)breq << 3) - totbits;

                if (breq > TBFSZ) {
                        bptr    = (char *) malloc(breq);

                        if (bptr == NULL) {     /* malloc() failed! */
                                errno   = FENOMEMY;
                                return(IOERR);
                        }
                }
/*
 *              read in the data
 */
                ret     = XRCALL(cup->ufp.fdc, readrtn) cup->ufp.fdc,
                                CPTR2BP(bptr), breq,
                                &cup->uffsw, mode, &ubc);

                *status = FF2FTNST(FFSTAT(cup->uffsw));

                if (*status == EOR)
                        cup->ulastyp    = DVTYPE_TYPELESS;

                if (ret <= 0) {         /* If an error or no data */
                        register long   stat = EOR;

                        if (bptr != tbuf)       /* Free allocated space */
                                free(bptr);

                        if (ret < 0) {
                                errno   = cup->uffsw.sw_error;
                                stat    = IOERR;
                        }

                        return(stat);
                }

/*
 *              If the read produced an integral number of items, return.
 *              else diagnose partial items.
 */
                totbits = ((uint64)ret << 3) - ubc;
                icount  = totbits / fdsize;

                if (((int64)icount * fdsize) != totbits) {
                        if (bptr != tbuf)       /* Free allocated space */
                                free(bptr);
                        /* partial items with conversion on is weird */
                        errno   = FDC_ERR_PITM;
                        return(IOERR);
                }
/*
 *              Do the numeric conversion
 */
                {
                register _f_int numerr;         /* Error code */
#ifdef  _CRAY
                _fcd            craychr;        /* Only used for char. conversion */

                craychr = _cptofcd((char *)uda, items);
#endif

                if (tip->newfunc) {
                        _f_int  flen;           /* Foreign length, in bits */
                        _f_int  nlen;           /* Native length, in bits */

                        flen    = fdsize;
                        nlen    = tip->intlen;

                        numerr  = cvt_fun(&dctype, &icount, (void *) bptr,
                                        &bitoff, (void *)uda, &stride, &nlen,
                                        &flen,
#ifdef  _CRAY
                                        craychr);
#else
                                        (char *)uda, items);
#endif
                }
                else {

                        numerr  = cvt_fun(&dctype, &icount, (void *)bptr,
                                        &bitoff, (void *)uda, &stride,
#ifdef  _CRAY
                                        craychr);
#else
                                        (char *)uda, items);
#endif
                }

                if (bptr != tbuf)       /* Free allocated space */
                        free(bptr);

                if (numerr != 0) {
                        errno   = (numerr < 0) ? FEINTUNK : FDC_ERR_NCVRT;
                        return(IOERR);
                }
                }
                }

                cup->urecpos    += totbits;
#endif  /* NUMERIC_DATA_CONVERSION_ENABLED */

                break;

        case FS_AUX:
                errno   = FEMIXAUX;
                icount  = IOERR;
                break;

        default:
                errno   = FEINTFST;
                icount  = IOERR;
                break;
        } /* switch */

done:
        return(icount);         /* Return number of items read or status */
}