/***********************************************************************
*
* asmfps.c - Floating Point Support routines for the IBM 7090 assembler.
*
* Changes:
*   12/30/04   DGP   Hacked from s709 arith routines.
*   03/15/05   DGP   Added dblprecision parm to ibm_strtod.
*   
***********************************************************************/

#include <stdio.h>
#include <ctype.h>

#include "asmdef.h"
#include "asmfps.h"
#include "asmnums.h"

static int spill;
static int divchk;

static uint16 srexp;
static uint16 sr2exp;
static uint16 acexp;
static uint16 mqexp;
static uint16 addrexp;

static uint8 srfrach; static uint32 srfracl;
static uint8 sr2frach; static uint32 sr2fracl;
static uint8 acfrach; static uint32 acfracl;
static uint8 mqfrach; static uint32 mqfracl;
static uint8 addrfrach; static uint32 addrfracl;

/*
** Floating Point functions.
*/

void
dofadd (int nrm)
{
   mqfrach = 0;
   mqfracl = 0;
   if (srexp < acexp)
   {
      if (acfrach & P)
         acfrach |= SIGN;
      addrfrach = srfrach;
      addrfracl = srfracl;
      addrexp = srexp;
      srfrach = acfrach & (SIGN|HMSK);
      srfracl = acfracl;
      srexp = acexp;
      acfrach = addrfrach;
      acfracl = addrfracl;
      acexp = addrexp;
   }
   mqfrach = acfrach;

   if (srexp - acexp > 077)
   {
      acfracl = 0;
      acexp = srexp;
   }
   else while (srexp > acexp)
   {
      mqfracl >>= 1;
      if (acfracl & 1)
         mqfracl |= 000400000000;
      acfracl >>= 1;
      acexp++;
      if (acexp & 0400)
         spill |= 006;
   }

   if (acfrach == srfrach)
   {
      acfracl += srfracl;
      if (acfracl & 001000000000)
      {
         mqfracl >>= 1;
         if (acfracl & 1)
            mqfracl |= 000400000000;
         acfracl >>= 1;
         acexp++;
         if (acexp & 0400)
            spill |= 006;
      }
   }
   else
   {
      if (srfracl > acfracl)
      {
         acfrach = mqfrach = srfrach;
         if (mqfracl == 0)
	 {
            acfracl = srfracl - acfracl;
         }
	 else
	 {
            acfracl = srfracl - acfracl - 1;
            mqfracl = (0-mqfracl) & 000777777777;
	 }
      }
      else
      {
         acfracl -= srfracl;
      }
   }

   if (nrm)
   {
      if (acfracl == 0 && mqfracl == 0)
      {
         acexp = 0;
      }
      else while ((acfracl & 000400000000) == 0)
      {
         acfracl = (acfracl & 000377777777) << 1;
         if (mqfracl & 000400000000)
            acfracl |= 1;
         mqfracl = (mqfracl & 000377777777) << 1;
         acexp--;
         if (acexp & 0400)
            spill |= 002;
      }
   }

   if (nrm && acfracl == 0 && mqfracl == 0)
   {
      mqexp = 0;
   }
   else
   {
      mqexp = acexp - 27;
      if (mqexp & 0400)
         spill |= 001;
   }
}

void
dofrnd()
{

   if (mqfracl & 000400000000)
   {
      if ((acfracl & 000777777777) == 000777777777)
      {
         acfracl += 000000000001;
         if (acfracl == 0)
	 {
            acfrach = ((acfrach + 1) & (Q|P|HMSK)) | (acfrach & SIGN);
            if ((acfrach & (Q|P)) == P)
               spill |= 006;
         }
         acfracl |= 000400000000;
      }
      else
      {
         acfracl += 000000000001;
      }
   }
}

void
dofmpy (int nrm)
{
   int shcnt;

   acfrach = 0;
   acfracl = 0;
   if ( (srfrach & HMSK) == 0 && srfracl == 0 )
   {
      mqfrach &= SIGN;
      mqfracl = 0;
      return;
   }
   acexp = srexp + mqexp - 128;
   if (acexp & 0400)
   {
      if (acexp & 01000)
         spill |= 002;
      else
         spill |= 006;
   }

   shcnt = 27;
   while (shcnt)
   {
      if (mqfracl & 1)
         acfracl += srfracl;
      mqfracl >>= 1;
      if (acfracl & 1)
         mqfracl |= 000400000000;
      acfracl >>= 1;
      shcnt--;
   }

   acfrach = (srfrach ^ mqfrach) & SIGN;

   if (nrm)
   {
      if (acfracl == 0)
      {
         acexp = 0;
      }
      else
      {
         if ((acfracl & 000400000000) == 0)
	 {
            acfracl <<= 1;
            if (mqfracl & 000400000000)
               acfracl += 1;
            mqfracl = (mqfracl << 1) & 000777777777;
            acexp--;
            if (acexp & 0400)
               spill |= 002;
         }
      }
   }

   if (nrm && acfracl == 0)
   {
      mqexp = 0;
   }
   else
   {
      mqexp = acexp - 27;
      if (mqexp & 0400)
         spill |= 001;
   }
   mqfrach = acfrach;
}

void
dofdiv()
{
   int shcnt;

   mqfracl = 0;
   mqfrach = (acfrach ^ srfrach) & SIGN;
   if (acfracl >= (srfracl << 1) || srfracl == 0)
   {
      divchk = 1;
      return;
   }
   if (acfracl == 0)
   {
      acfrach = 0;
      acexp = 0;
      acfracl = 0;
      return;
   }
   if (acfracl >= srfracl)
   {
      if (acfracl & 1)
         mqfracl |= 000400000000;
      acfracl >>= 1;
      acexp++;
   }
   mqexp = acexp - srexp + 128;
   if (mqexp & 0400)
   {
      if (mqexp & 01000)
         spill |= 001;
      else
         spill |= 005;
   }

   shcnt = 27;
   while (shcnt)
   {
      acfracl <<= 1;
      if (mqfracl & 000400000000)
         acfracl++;
      mqfracl = (mqfracl << 1) & 000777777777;
      if (srfracl <= acfracl)
      {
         mqfracl++;
         acfracl -= srfracl;
      }
      shcnt--;
   }

   acexp -= 27;
   if (acexp & 0400)
      spill |= 002;
   if (spill)
      spill |= 010;
}

/*
 * Single Precision 
 */

int
ibm_fadd (t_uint64 *op1, t_uint64 *op2, int nrm)
{
   int ret;

   spill = 0;
   divchk = 0;

   srexp = (uint16)((*op2 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   srfrach = ((*op2 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   srfracl = (uint32)((*op2 >> EXPSHIFT) & FRACMASK);

   acexp = (uint16)((*op1 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   acfrach = ((*op1 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   acfracl = (uint32)((*op1 >> EXPSHIFT) & FRACMASK);

   mqexp = acexp - 27;
   mqfrach = acfrach;
   mqfracl = (uint32)(*op1 & FRACMASK);

   dofadd(nrm);

   *op1 = ((t_uint64)acexp << (EXPSHIFT+EXPSHIFT)) | 
	  ((t_uint64)(acfrach & SIGN ? 1 : 0) << (SIGNSHIFT+EXPSHIFT)) |
	  (t_uint64)acfracl << EXPSHIFT |
	  (t_uint64)mqfracl ;

   if (spill != 0 || divchk != 0) ret = -1;
   return (ret);
}

int
ibm_frnd (t_uint64 *op1, int nrm)
{
   int ret;

   spill = 0;
   divchk = 0;

   acexp = (uint16)((*op1 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   acfrach = ((*op1 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   acfracl = (uint32)((*op1 >> EXPSHIFT) & FRACMASK);

   mqexp = acexp - 27;
   mqfrach = acfrach;
   mqfracl = (uint32)(*op1 & FRACMASK);

   dofrnd(nrm);

   *op1 = ((t_uint64)acexp << (EXPSHIFT+EXPSHIFT)) | 
	  ((t_uint64)(acfrach & SIGN ? 1 : 0) << (SIGNSHIFT+EXPSHIFT)) |
	  (t_uint64)acfracl << EXPSHIFT |
	  (t_uint64)mqfracl ;

   if (spill != 0 || divchk != 0) ret = -1;
   return (ret);
}

int
ibm_fmpy(t_uint64 *op1, t_uint64 *op2, int nrm)
{
   int ret;

   spill = 0;
   divchk = 0;

   srexp = (uint16)((*op2 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   srfrach = ((*op2 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   srfracl = (uint32)((*op2 >> EXPSHIFT) & FRACMASK);

   mqexp = (uint16)((*op1 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   mqfrach = ((*op1 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   mqfracl = (uint32)((*op1 >> EXPSHIFT) & FRACMASK);

   dofmpy(nrm);

   *op1 = ((t_uint64)acexp << (EXPSHIFT+EXPSHIFT)) | 
	  ((t_uint64)(acfrach & SIGN ? 1 : 0) << (SIGNSHIFT+EXPSHIFT)) |
	  (t_uint64)acfracl << EXPSHIFT |
	  (t_uint64)mqfracl ;

   if (spill != 0 || divchk != 0) ret = -1;
   return (ret);
}

int
ibm_fdiv (t_uint64 *op1, t_uint64 *op2)
{
   int ret;

   spill = 0;
   divchk = 0;

   srexp = (uint16)((*op2 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   srfrach = ((*op2 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   srfracl = (uint32)((*op2 >> EXPSHIFT) & FRACMASK);

   acexp = (uint16)((*op1 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   acfrach = ((*op1 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   acfracl = (uint32)((*op1 >> EXPSHIFT) & FRACMASK);

   mqexp = acexp - 27;
   mqfrach = acfrach;
   mqfracl = (uint32)(*op1 & FRACMASK);

   dofdiv();

   *op1 = ((t_uint64)acexp << (EXPSHIFT+EXPSHIFT)) | 
	  ((t_uint64)(acfrach & SIGN ? 1 : 0) << (SIGNSHIFT+EXPSHIFT)) |
	  (t_uint64)acfracl << EXPSHIFT |
	  (t_uint64)mqfracl ;

   if (spill != 0 || divchk != 0) ret = -1;
   return (ret);
}

/*
** Double Precision 
*/

int
ibm_dfadd (t_uint64 *op1, t_uint64 *op2, int nrm)
{
   int ret;
   uint16 lsrexp; uint8 lsrh; uint32 lsrl;
   uint16 le1exp; uint8 le1h; uint32 le1l;
   uint16 le2exp; uint8 le2h; uint32 le2l;

   spill = 0;
   divchk = 0;

   srexp = (uint16)((*op2 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   srfrach = ((*op2 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   srfracl = (uint32)((*op2 >> EXPSHIFT) & FRACMASK);

   sr2exp = srexp - 27;
   sr2frach = srfrach;
   sr2fracl = (uint32)(*op2 & FRACMASK);

   acexp = (uint16)((*op1 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   acfrach = ((*op1 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   acfracl = (uint32)((*op1 >> EXPSHIFT) & FRACMASK);

   mqexp = acexp - 27;
   mqfrach = acfrach;
   mqfracl = (uint32)(*op1 & FRACMASK);

   lsrexp = srexp; lsrh = srfrach; lsrl = srfracl;

   /* STQ   e.1 */
   le1exp = mqexp; le1h = mqfrach; le1l = mqfracl;

   /* FAD   y,t */
   dofadd(nrm);

   /* STO   e.2 */
   le2exp = acexp; le2h = acfrach; le2l = acfracl;

   /* XCA       */
   srexp = acexp; srfrach = acfrach; srfracl = acfracl;
   acexp = mqexp; acfrach = mqfrach; acfracl = mqfracl;
   mqexp = srexp; mqfrach = srfrach; mqfracl = srfracl;

   /* FAD   e.1 */
   srexp = le1exp; srfrach = le1h; srfracl = le1l;
   dofadd(1);

   /* FAD   y+1,t */
   srexp = sr2exp; srfrach = sr2frach; srfracl = sr2fracl;
   dofadd(nrm);

   /* FAD   e.2 */
   srexp = le2exp; srfrach = le2h; srfracl = le2l;
   dofadd(1);

   *op1 = ((t_uint64)acexp << (EXPSHIFT+EXPSHIFT)) | 
	  ((t_uint64)(acfrach & SIGN ? 1 : 0) << (SIGNSHIFT+EXPSHIFT)) |
	  (t_uint64)acfracl << EXPSHIFT |
	  (t_uint64)mqfracl ;

   if (spill != 0 || divchk != 0) ret = -1;
   return (ret);
}

int
ibm_dfmpy (t_uint64 *op1, t_uint64 *op2, int nrm)
{
   int ret;
   uint16 lsrexp; uint8 lsrh; uint32 lsrl;
   uint16 le1exp; uint8 le1h; uint32 le1l;
   uint16 le2exp; uint8 le2h; uint32 le2l;
   uint16 le3exp; uint8 le3h; uint32 le3l;
   uint16 le4exp; uint8 le4h; uint32 le4l;

   spill = 0;
   divchk = 0;

   srexp = (uint16)((*op2 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   srfrach = ((*op2 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   srfracl = (uint32)((*op2 >> EXPSHIFT) & FRACMASK);

   sr2exp = srexp - 27;
   sr2frach = srfrach;
   sr2fracl = (uint32)(*op2 & FRACMASK);

   acexp = (uint16)((*op1 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   acfrach = ((*op1 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   acfracl = (uint32)((*op1 >> EXPSHIFT) & FRACMASK);

   mqexp = acexp - 27;
   mqfrach = acfrach;
   mqfracl = (uint32)(*op1 & FRACMASK);

   lsrexp = srexp; lsrh = srfrach; lsrl = srfracl;

   /* STO   e.1 */
   le1exp = acexp; le1h = acfrach; le1l = acfracl;

   /* FMP   y,t */
   dofmpy(1);

   /* STO   e.2 */
   le2exp = acexp; le2h = acfrach; le2l = acfracl;

   /* LDQ   y,t */
   mqexp = lsrexp; mqfrach = lsrh; mqfracl = lsrl;

   /* FMP   e.1 */
   srexp = le1exp; srfrach = le1h; srfracl = le1l;
   dofmpy(1);

   /* STQ   e.3 */
   le3exp = mqexp; le3h = mqfrach; le3l = mqfracl;

   /* STO   e.4 */
   le4exp = acexp; le4h = acfrach; le4l = acfracl;

   /* LDQ   y+1,t */
   mqexp = sr2exp; mqfrach = sr2frach; mqfracl = sr2fracl;

   /* FMP   e.1 */
   srexp = le1exp; srfrach = le1h; srfracl = le1l;
   dofmpy(1);

   /* FAD   e.2 */
   srexp = le2exp; srfrach = le2h; srfracl = le2l;
   dofadd(nrm);

   /* FAD   e.3 */
   srexp = le3exp; srfrach = le3h; srfracl = le3l;
   dofadd(1);

   /* FAD   e.4 */
   srexp = le4exp; srfrach = le4h; srfracl = le4l;
   dofadd(1);

   *op1 = ((t_uint64)acexp << (EXPSHIFT+EXPSHIFT)) | 
	  ((t_uint64)(acfrach & SIGN ? 1 : 0) << (SIGNSHIFT+EXPSHIFT)) |
	  (t_uint64)acfracl << EXPSHIFT |
	  (t_uint64)mqfracl ;

   if (spill != 0 || divchk != 0) ret = -1;
   return (ret);
}

int
ibm_dfdiv (t_uint64 *op1, t_uint64 *op2)
{
   int ret;
   uint16 lsrexp; uint8 lsrh; uint32 lsrl;
   uint16 le1exp; uint8 le1h; uint32 le1l;
   uint16 le2exp; uint8 le2h; uint32 le2l;
   uint16 le3exp; uint8 le3h; uint32 le3l;


   spill = 0;
   divchk = 0;

   srexp = (uint16)((*op2 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   srfrach = ((*op2 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   srfracl = (uint32)((*op2 >> EXPSHIFT) & FRACMASK);

   sr2exp = srexp - 27;
   sr2frach = srfrach;
   sr2fracl = (uint32)(*op2 & FRACMASK);

   acexp = (uint16)((*op1 >> (EXPSHIFT+EXPSHIFT)) & SEXPMASK);
   acfrach = ((*op1 >> (SIGNSHIFT+EXPSHIFT)) & 1) ? SIGN : 0;
   acfracl = (uint32)((*op1 >> EXPSHIFT) & FRACMASK);

   mqexp = acexp - 27;
   mqfrach = acfrach;
   mqfracl = (uint32)(*op1 & FRACMASK);

   lsrexp = srexp; lsrh = srfrach; lsrl = srfracl;

   /* STQ   e.1 */
   le1exp = mqexp; le1h = mqfrach; le1l = mqfracl;

   /* FDP   y,t */
   dofdiv();

   /* STO   e.2 */
   le2exp = acexp; le2h = acfrach; le2l = acfracl;

   /* STQ   e.3 */
   le3exp = mqexp; le3h = mqfrach; le3l = mqfracl;

   /* FMP   y+1,t */
   srexp = sr2exp; srfrach = sr2frach; srfracl = sr2fracl;
   dofmpy(1);

   /* CHS       */
   acfrach = (~acfrach & SIGN) | (acfrach & (Q|P|HMSK));

   /* FAD   e.2 */
   srexp = le2exp; srfrach = le2h; srfracl = le2l;
   dofadd(1);

   /* FAD   e.1 */
   srexp = le1exp; srfrach = le1h; srfracl = le1l;
   dofadd(1);

   /* FDP   y,t */
   srexp = lsrexp; srfrach = lsrh; srfracl = lsrl;
   dofdiv();

   /* XCA       */
   srexp = acexp; srfrach = acfrach; srfracl = acfracl;
   acexp = mqexp; acfrach = mqfrach; acfracl = mqfracl;
   mqexp = srexp; mqfrach = srfrach; mqfracl = srfracl;

   /* FAD   e.3 */
   srexp = le3exp; srfrach = le3h; srfracl = le3l;
   dofadd(1);

   *op1 = ((t_uint64)acexp << (EXPSHIFT+EXPSHIFT)) | 
	  ((t_uint64)(acfrach & SIGN ? 1 : 0) << (SIGNSHIFT+EXPSHIFT)) |
	  (t_uint64)acfracl << EXPSHIFT |
	  (t_uint64)mqfracl ;

   if (spill != 0 || divchk != 0) ret = -1;
   return (ret);
}

int
ibm_strtod (char *num, t_uint64 *result, int dblprecision)
{
   double cvtfrac;
   t_uint64 retval;
   t_uint64 fraction = 0;
   t_uint64 residual = 0;
   t_uint64 mantissa = 0;
   t_uint64 evalue = 0;
   t_uint64 temp;
   int maxshft;
   int ret;
   int sign;
   int expsgn;
   uint16 exponent = 0200;
   char ftemp[82];

#ifdef DEBUGSTRTOD
   printf ( "ibm_strtod: num = %s\n", num);
#endif
   ret = 0;

   /*
   ** Scan off sign
   */

   sign = 0;
   if (*num == '+')
   {
      num++;
   }
   else if (*num == '-')
   {
      sign = 1;
      num++;
   }

   /*
   ** Scan off leading digits
   */

   while (*num && isdigit(*num)) evalue = evalue * 10 + (*num++ - '0');

   /*
   ** Scan off fraction and convert
   */

   if (*num == '.')
   {
      char *fp;

      fp = ftemp;;
      *fp++ = *num++;
      while (*num && isdigit(*num)) *fp++ = *num++;
      *fp = '\0';
      sscanf (ftemp, "%lf", &cvtfrac);

      fraction = 1; /* Guard bit */
      while (!(fraction & 0010000000000))
      {
	 int d;
	 
	 cvtfrac *= 8.0;
	 d = cvtfrac;
	 cvtfrac = cvtfrac - d;
	 fraction = (fraction << 3) | d;
      }
      residual = 010 | (fraction & 07);
      fraction >>= 3;
      while (!(residual & 0001000000000))
      {
	 int d;
	 
	 cvtfrac *= 8.0;
	 d = cvtfrac;
	 cvtfrac = cvtfrac - d;
	 residual = (residual << 3) | d;
      }
   }

#ifdef DEBUGSTRTOD
   printf ("   exponent = %o\n", exponent);
   printf ("   evalue   = %o\n", evalue);
   printf ("   fraction = %o\n", fraction);
   printf ("   residual = %o\n", residual);
#endif

   /*
   ** Merge whole and fractional parts
   */

   if (evalue > 0)
   {
      int sc;

      temp = evalue;
      while (temp)
      {
	 temp >>= 1;
	 exponent++;
      }

      sc = 0;
      mantissa = evalue;
      maxshft = 9;
      while (maxshft && !(mantissa & 0000700000000))
      {
	 mantissa <<= 3;
	 maxshft--;
	 sc++;
      }
      if (fraction)
      {
	 fraction &= 0000777777777;
	 mantissa |= (fraction >>= ((9-sc) * 3));
	 fraction <<= (sc * 3);
      }
      maxshft = 27;
      while (maxshft && !(mantissa & 0000400000000))
      {
	 mantissa <<= 1;
	 mantissa |= ((fraction & 0000400000000) >> 26);
	 fraction = (fraction << 1) & 0000777777777;
	 fraction |= ((residual & 0000400000000) >> 26);
	 residual = (residual << 1) & 0000777777777;
	 maxshft--;
      }
   }
   else
   {
      mantissa = fraction & 0000777777777;
      maxshft = 27;
      while (maxshft && !(mantissa & 0000400000000))
      {
	 mantissa <<= 1;
	 mantissa |= ((residual & 0000400000000) >> 26);
	 residual = (residual << 1) & 0000777777777;
	 exponent --;
	 maxshft--;
      }
   }

   retval = ((t_uint64)(sign & 1) << (SIGNSHIFT+EXPSHIFT)) |
	   ((t_uint64)(exponent & SEXPMASK) << (EXPSHIFT+EXPSHIFT)) |
	   ((mantissa & FRACMASK) << EXPSHIFT) |
	   (residual & FRACMASK);
   
#ifdef DEBUGSTRTOD
   printf ("   exponent = %o\n", exponent);
   printf ("   mantissa = %o\n", mantissa);
   printf ("   residual = %o\n", residual);
   printf ("   retval   = %llo\n", retval);
#endif

   /*
   ** Check for exponent
   */

   if (*num == 'E')
   {
      t_uint64 op2;
      int sexp;

      num++;
      if (*num == 'E') num++;

      expsgn = 1;
      if (*num == '+')
      {
	 num++;
      }
      else if (*num == '-')
      {
	 num++;
	 expsgn = -1;
      }

      sexp = 0;
      while (*num && isdigit(*num)) sexp = sexp * 10 + (*num++ - '0');

      if (expsgn > 0)
	 op2 = dptens[sexp];
      else
	 op2 = dmtens[sexp-1];
#ifdef DEBUGSTRTOD
      printf ("   sexp = %d\n", sexp);
#endif

      ret = ibm_dfmpy (&retval, &op2, 1);

      /*
      ** If not dblprecision and positive exponent, round up 
      */

      if (!dblprecision && expsgn > 0) ibm_frnd (&retval, 1);

#ifdef DEBUGSTRTOD
      printf ("   retval   = %21.21llo\n", retval);
#endif
   }
   *result = retval;
   return (ret);
}
