s2uo.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/s2uo.c     92.1    06/18/99 18:41:02"
#include <fortran.h>
#include <cray/fmtconv.h>
#include <cray/portdefs.h>

#define MXBITS  64              /* Number of bits in an octal value     */
#define MXDGTS  22              /* Number of digits in one octal value  */
#define MXSIZE  (MXDGTS + 1)    /* Size of one octal value plus blank   */
#define DGSIZE  3               /* Size of one octal digit (in bits)    */
#define UNDP    (MODEUN | MODEDP)

extern oc_func _S2UO;           /* Interface must match oc_func prototype */

/*
 *      _S2UO() Convert Fortran integer variable to octal format.
 *
 *      Entry:
 *              value   Address of logical variable
 *              fca     Address of first unpacked character
 *              mode    Address of mode bits
 *              width   Address of field width
 *              digits  Address of digits field
 *              exp     Unused
 *              scale   Unused
 *
 *      Exit:
 *              result  Points to end of output field
 *
 *      Note:   This routine has the same parameters as S2UI, etc. in
 *              libc.  It does CRAYs implementation of the O edit
 *              descriptor (automatically masks the field down to the
 *              size specified by the edit descriptor and always does
 *              leading zeroes if the digits field is not set by the
 *              user (digits is 1 and MODE77)).  It also handles double-
 *              precision values via two calls to _s2uo if the field
 *              width is large enough.
 */

long *
_S2UO(
const void      *value,
long            *fca,
const long      *mode,
const long      *width,
const long      *digits,
const long      *exp,
const long      *scale
)
{
        int64   datum;
#ifdef  _F_INT4
        int32   datum32;
#endif
#if     defined(_F_INT2) && defined(__mips)
        _f_int2 datum16;
        _f_int1 datum8;
#endif
        long    fd, fw, m77, nfd, *ptr;

        fd      = *digits;
        fw      = *width;

#ifdef  _F_INT4
        if ((*mode & MODEHP) != 0)
                datum   = *(_f_int4 *)value;
        else
#if     defined(_F_INT2) && defined(__mips)
        if ((*mode & MODEWP) != 0)
                datum   = *(_f_int2 *)value;
        else if ((*mode & MODEBP) != 0)
                datum   = *(_f_int1 *)value;
        else
#endif
#endif
        {
                datum   = *(_f_int8 *)value;
        }
        ptr     = fca;
        m77     = (*mode & MODE77);     /* Fortran 77 mode */

        /* Check if double-precision value and field is large enough. */

        if ((*mode & UNDP) == UNDP && fw > MXSIZE) {

                if (fd == 1 && m77 != 0)
                        fd      = fw;

                fw     -= MXSIZE;
                nfd     = fd - MXDGTS;

                if (nfd < 0)
                        nfd     = 0;
                else
                        if (nfd > fw)
                                nfd     = fw;

                if (m77 != 0) { /* If Fortran 77 mode */
                        long    mask, temp;

                        temp    = fw * DGSIZE;
                        mask    = (temp < MXBITS) ? ((1 << temp) - 1) : ~0;
                        datum   = datum & mask;
                }

                ptr     = _s2uo(&datum, ptr, mode, &fw, &nfd, exp, scale);

                datum   = *((int64 *)value + 1);
                fw      = MXSIZE;

                if (fd > MXDGTS)
                        fd      = MXDGTS;
        }
        else
                if (fd == 1 && m77 != 0)
                        fd      = (fw > MXDGTS) ? MXDGTS : fw;

        if (m77 != 0) { /* If Fortran 77 mode */
                long    mask, temp;

                temp    = fw * DGSIZE;
                mask    = (temp < MXBITS) ? ((1 << temp) - 1) : ~0;
                datum   = datum & mask;
        }

#ifdef  _F_INT4
        if ((*mode & MODEHP) != 0) {
                datum32 = datum;
                value   = &datum32;
        }
        else
#if     defined(_F_INT2) && defined(__mips)
        if ((*mode & MODEWP) != 0) {
                datum16 = datum;
                value   = &datum16;
        }
        else if ((*mode & MODEBP) != 0){
                datum8  = datum;
                value   = &datum8;
        }
        else
#endif
#endif
                value   = &datum;

        return( _s2uo(value, ptr, mode, &fw, &fd, exp, scale) );
}