dis_long_double_t
disrl(int stream, int *retval)
{
int expon;
unsigned uexpon;
int locret;
int negate;
unsigned ndigs;
unsigned nskips;
dis_long_double_t ldval;
assert(retval != NULL);
assert(disr_commit != NULL);
ldval = 0.0L;
locret = disrl_(stream, &ldval, &ndigs, &nskips, LDBL_DIG, 1, 0);
if (locret == DIS_SUCCESS) {
locret = disrsi_(stream, &negate, &uexpon, 1, 0);
if (locret == DIS_SUCCESS) {
expon = negate ? nskips - uexpon : nskips + uexpon;
if (expon + (int)ndigs > LDBL_MAX_10_EXP) {
if (expon + (int)ndigs > LDBL_MAX_10_EXP + 1) {
ldval = ldval < 0.0L ?
-HUGE_VAL : HUGE_VAL;
locret = DIS_OVERFLOW;
} else {
ldval *= disp10l_(expon - 1);
if (ldval > LDBL_MAX / 10.0L) {
ldval = ldval < 0.0L ?
-HUGE_VAL : HUGE_VAL;
locret = DIS_OVERFLOW;
} else
ldval *= 10.0L;
}
} else {
if (expon < LDBL_MIN_10_EXP) {
ldval *= disp10l_(expon + (int)ndigs);
ldval /= disp10l_((int)ndigs);
} else
ldval *= disp10l_(expon);
}
}
}
if ((*disr_commit)(stream, locret == DIS_SUCCESS) < 0)
locret = DIS_NOCOMMIT;
*retval = locret;
return (ldval);
}
double disrd(
struct tcp_chan *chan,
int *retval)
{
int expon;
unsigned uexpon;
int locret;
int negate;
unsigned ndigs;
unsigned nskips;
dis_long_double_t ldval;
assert(retval != NULL);
ldval = 0.0L;
locret = disrl_(chan, &ldval, &ndigs, &nskips, DBL_DIG, 1);
if (locret == DIS_SUCCESS)
{
locret = disrsi_(chan, &negate, &uexpon, 1);
if (locret == DIS_SUCCESS)
{
expon = negate ? nskips - uexpon : nskips + uexpon;
if (expon + (int)ndigs > DBL_MAX_10_EXP)
{
if (expon + (int)ndigs > DBL_MAX_10_EXP + 1)
{
ldval = ldval < 0.0L ?
-HUGE_VAL : HUGE_VAL;
locret = DIS_OVERFLOW;
}
else
{
ldval *= disp10l_(expon - 1);
if (ldval > DBL_MAX / 10.0L)
{
ldval = ldval < 0.0L ?
-HUGE_VAL : HUGE_VAL;
locret = DIS_OVERFLOW;
}
else
ldval *= 10.0L;
}
}
else
{
if (expon < LDBL_MIN_10_EXP)
{
ldval *= disp10l_(expon + (int)ndigs);
ldval /= disp10l_((int)ndigs);
}
else
ldval *= disp10l_(expon);
}
}
}
if (tcp_rcommit(chan, locret == DIS_SUCCESS) < 0)
locret = DIS_NOCOMMIT;
*retval = locret;
return((double)ldval);
}
int diswl_(
struct tcp_chan *chan,
dis_long_double_t value,
unsigned ndigs)
{
int c;
int expon;
int negate;
int retval;
unsigned pow2;
char *cp;
char *ocp;
dis_long_double_t ldval;
char scratch[DIS_BUFSIZ+1];
assert(ndigs > 0 && ndigs <= LDBL_DIG);
memset(scratch, 0, DIS_BUFSIZ+1);
/* Make zero a special case. If we don't it will blow exponent */
/* calculation. */
if (value == 0.0L)
{
retval = tcp_puts(chan, "+0+0", 4) < 0 ?
DIS_PROTO : DIS_SUCCESS;
return ((tcp_wcommit(chan, retval == DIS_SUCCESS) < 0) ?
DIS_NOCOMMIT : retval);
}
/* Extract the sign from the coefficient. */
ldval = (negate = value < 0.0L) ? -value : value;
/* Detect and complain about the infinite form. */
if (ldval > LDBL_MAX)
return (DIS_HUGEVAL);
/* Compute the integer part of the log to the base 10 of ldval. As a */
/* byproduct, reduce the range of ldval to the half-open interval, */
/* [1, 10). */
if (dis_lmx10 == 0)
disi10l_();
expon = 0;
pow2 = dis_lmx10 + 1;
if (ldval < 1.0L)
{
do
{
if (ldval < dis_ln10[--pow2])
{
ldval *= dis_lp10[pow2];
expon += 1 << pow2;
}
}
while (pow2);
ldval *= 10.0;
expon = -expon - 1;
}
else
{
do
{
if (ldval >= dis_lp10[--pow2])
{
ldval *= dis_ln10[pow2];
expon += 1 << pow2;
}
}
while (pow2);
}
/* Round the value to the last digit */
ldval += 5.0L * disp10l_(-ndigs);
if (ldval >= 10.0L)
{
expon++;
ldval *= 0.1L;
}
/* Starting in the middle of the buffer, convert coefficient digits, */
/* most significant first. */
ocp = cp = &scratch[DIS_BUFSIZ - ndigs];
do
{
c = ldval;
ldval = (ldval - c) * 10.0L;
*ocp++ = c + '0';
}
while (--ndigs);
/* Eliminate trailing zeros. */
while (*--ocp == '0');
/* The decimal point is at the low order end of the coefficient */
/* integer, so adjust the exponent for the number of digits in the */
/* coefficient. */
ndigs = ++ocp - cp;
expon -= ndigs - 1;
/* Put the coefficient sign into the buffer, left of the coefficient. */
*--cp = negate ? '-' : '+';
/* Insert the necessary number of counts on the left. */
while (ndigs > 1)
cp = discui_(cp, ndigs, &ndigs);
/* The complete coefficient integer is done. Put it out. */
retval = tcp_puts(chan, cp, (size_t)(ocp - cp)) < 0 ?
DIS_PROTO : DIS_SUCCESS;
/* If that worked, follow with the exponent, commit, and return. */
if (retval == DIS_SUCCESS)
return (diswsi(chan, expon));
/* If coefficient didn't work, negative commit and return the error. */
return ((tcp_wcommit(chan, FALSE) < 0) ? DIS_NOCOMMIT : retval);
}
