/**************************************************************************/
/*                                                                        */
/*                                 Sources                                */
/*                                from  the                               */
/*                           XSC SOFTWARE PACKAGE                         */
/*                                                                        */
/*                Copyright (c) 1997 University of Karlsruhe              */
/*                     Institute for Appl. Mathematics                    */
/*                                                                        */
/* This program is free software for non-commercial use. For details, see */
/* the file LICENSE.XSC, distributed with this software package.          */
/*                                                                        */
/* This program is distributed WITHOUT ANY WARRANTY. For details, see the */
/* file LICENSE.XSC, distributed with this software package.              */
/*                                                                        */
/**************************************************************************/

/* RCS $Id: b_rndd.c,v 1.2 1997/09/25 17:06:05 ae59 Exp $ */
/*
$Log: b_rndd.c,v $
 * Revision 1.2  1997/09/25  17:06:05  ae59
 * Copyright-message
 *
 * Revision 1.1  1994/01/27  13:21:38  ae59
 * Put under RCS control
 *
 */
/****************************************************************/
/*                                                              */
/*      Filename        : b_rndd.c                              */
/*                                                              */
/*      Entries         : a_btyp b_rndd(lang,expo,vz)           */
/*                        a_btyp *lang;                         */
/*                        a_intg *expo;                         */
/*                        a_bool vz;                            */
/*                                                              */
/*      Arguments       : lang = result mantissa of length BSIZE*/
/*                        expo = exponent of result             */
/*                        vz = sign of result                   */
/*                                                              */
/*      Description     : Round downwards to IEEE number by     */
/*                        changing value of lang+D_U_RATIO-1    */
/*                                                              */
/*      Function value  : error code                            */
/*                        OVERFLOW - overflow occurred          */
/*                        INEXACT - inexact result              */
/*                                                              */
/*      Date            : 1991-11-11                            */
/*      1991-11-11 : set overflow flag                          */
/*      1991-05-20 : no code changed but comments               */
/*      1991-05-02 : use status flags                           */
/*      1990-07-06 : LINT_ARGS prototype                        */
/*                   unnecessary e_sofo() removed               */
/*      1990-07-19 : unused variable rc removed                 */
/****************************************************************/

#ifndef ALL_IN_ONE
#ifdef AIX
#include "/u/p88c/runtime/o_defs.h"
#else
#include "o_defs.h"
#endif
#define local
extern a_bool e_efie;
extern a_bool e_efof;
extern a_bool e_ofie;
extern a_bool e_ofof;
#endif

#ifdef LINT_ARGS
local a_btyp b_rndd(a_btyp *lang,a_intg *expo,a_bool vz)
#else
local a_btyp b_rndd(lang,expo,vz)

a_btyp *lang;
a_intg *expo;
a_bool vz;
#endif
        {
        a_intg k;

        /* number is positive (no rounding required) */
        if (NOT(vz))
           {

           /* test for inexact data */
           for (k=D_U_RATIO;k<BSIZE;k++)
              {
              if (lang[k])
                 {
                 if (e_efie) return(INEXACT);
                 e_ofie = TRUE;
                 return(NO_ERROR);
                 }
              }
           return(NO_ERROR);
           }

        /* add correction if trailing mantissa is non-zero */
        for (k=D_U_RATIO;k<BSIZE;k++)
           {
           if (lang[k])
              {

              /* propagate carry */
              b_addc(lang+(D_U_RATIO-1));

              /* normalization (only msb is set) */
              if (SHFT_MASK & *lang)
                 {
                 *lang = HIDDEN_BIT;
                 (*expo)++;

                 /* overflow occurred */
                 if (*expo>EXPO_MAX)
                    {
                    if (e_efof)
                       {
                       *expo -= EXPO_ADJUST;
                       return(OVERFLOW);
                       }
                    e_ofof = TRUE;
                    }
                 }
              if (e_efie) return(INEXACT);
              e_ofie = TRUE;
              return(NO_ERROR);
              }
           }

        return(NO_ERROR);
        }
