1988-08-11 14:50:18 +00:00
|
|
|
/*
|
1988-04-07 11:40:46 +00:00
|
|
|
(c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
|
|
|
|
See the copyright notice in the ACK home directory, in the file "Copyright".
|
|
|
|
*/
|
|
|
|
|
|
|
|
/* $Header$ */
|
|
|
|
|
1988-04-07 10:57:49 +00:00
|
|
|
/*
|
|
|
|
COMPACT EXTEND FORMAT INTO FLOAT OF PROPER SIZE
|
|
|
|
*/
|
|
|
|
|
|
|
|
# include "FP_bias.h"
|
|
|
|
# include "FP_shift.h"
|
|
|
|
# include "FP_trap.h"
|
|
|
|
# include "FP_types.h"
|
|
|
|
# include "get_put.h"
|
|
|
|
|
|
|
|
compact(f,to,size)
|
|
|
|
EXTEND *f;
|
|
|
|
_double *to;
|
|
|
|
int size;
|
|
|
|
{
|
|
|
|
int error = 0;
|
|
|
|
|
1988-07-25 10:46:15 +00:00
|
|
|
if (size == sizeof(_double)) {
|
|
|
|
/*
|
|
|
|
* COMPACT EXTENDED INTO DOUBLE
|
|
|
|
*/
|
1988-08-04 18:10:34 +00:00
|
|
|
DOUBLE *DBL;
|
|
|
|
|
1988-04-07 10:57:49 +00:00
|
|
|
if ((f->m1|(f->m2 & DBL_ZERO)) == 0L) {
|
|
|
|
zrf8(to);
|
1988-07-25 10:46:15 +00:00
|
|
|
return;
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
|
|
|
f->exp += DBL_BIAS; /* restore proper bias */
|
|
|
|
if (f->exp > DBL_MAX) {
|
|
|
|
dbl_over: trap(EFOVFL);
|
1989-07-25 14:21:09 +00:00
|
|
|
f->exp = DBL_MAX+1;
|
|
|
|
f->m1 = 0;
|
|
|
|
f->m2 = 0;
|
1988-04-07 10:57:49 +00:00
|
|
|
if (error++)
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
else if (f->exp < DBL_MIN) {
|
1989-07-25 14:21:09 +00:00
|
|
|
b64_rsft(&(f->m1));
|
|
|
|
if (f->exp < 0) {
|
|
|
|
b64_sft(&(f->m1), -f->exp);
|
|
|
|
f->exp = 0;
|
|
|
|
}
|
|
|
|
/* underflow ??? */
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
/* local CAST conversion */
|
|
|
|
DBL = (DOUBLE *) to;
|
|
|
|
|
|
|
|
/* because of special format shift only 10 bits */
|
|
|
|
/* bit shift mantissa 10 bits */
|
|
|
|
|
|
|
|
/* first align within words, then do store operation */
|
|
|
|
|
|
|
|
DBL->_s.p1.fract = f->m1 >> DBL_RUNPACK; /* plus 22 == 32 */
|
|
|
|
DBL->_s.p2 = f->m2 >> DBL_RUNPACK; /* plus 22 == 32 */
|
|
|
|
DBL->_s.p2 |= (f->m1 << DBL_LUNPACK); /* plus 10 == 32 */
|
|
|
|
|
|
|
|
/* if not exact then round to nearest */
|
|
|
|
|
1988-08-04 18:10:34 +00:00
|
|
|
#ifdef EXCEPTION_INEXACT
|
|
|
|
if ((f->m2 & DBL_EXACT) != 0) {
|
|
|
|
INEXACT();
|
|
|
|
#endif
|
1988-04-07 10:57:49 +00:00
|
|
|
if (f->m2 & DBL_ROUNDUP) {
|
|
|
|
DBL->_s.p2++; /* rounding up */
|
|
|
|
if (DBL->_s.p2 == 0L) { /* carry out */
|
|
|
|
DBL->_s.p1.fract++;
|
|
|
|
if (DBL->_s.p1.fract & DBL_CARRYOUT) { /* carry out */
|
|
|
|
if (DBL->_s.p1.fract & 01)
|
|
|
|
DBL->_s.p2 = CARRYBIT;
|
|
|
|
DBL->_s.p1.fract >>= 1;
|
|
|
|
f->exp++;
|
|
|
|
}
|
|
|
|
}
|
1988-08-04 18:10:34 +00:00
|
|
|
/* check for overflow */
|
|
|
|
if (f->exp > DBL_MAX)
|
|
|
|
goto dbl_over;
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
1988-08-04 18:10:34 +00:00
|
|
|
#ifdef EXCEPTION_INEXACT
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
1988-08-04 18:10:34 +00:00
|
|
|
#endif
|
1988-04-07 10:57:49 +00:00
|
|
|
|
1988-07-25 10:46:15 +00:00
|
|
|
/*
|
1988-08-04 18:10:34 +00:00
|
|
|
* STORE EXPONENT AND SIGN:
|
1988-07-25 10:46:15 +00:00
|
|
|
*
|
|
|
|
* 1) clear leading bits (B4-B15)
|
|
|
|
* 2) shift and store exponent
|
|
|
|
*/
|
1988-04-07 10:57:49 +00:00
|
|
|
|
|
|
|
DBL->_s.p1.fract &= DBL_MASK;
|
1988-08-04 18:10:34 +00:00
|
|
|
DBL->_s.p1.fract |=
|
|
|
|
((long) (f->exp << DBL_EXPSHIFT) << EXP_STORE);
|
|
|
|
if (f->sign)
|
|
|
|
DBL->_s.p1.fract |= CARRYBIT;
|
|
|
|
|
|
|
|
/*
|
|
|
|
* STORE MANTISSA
|
|
|
|
*/
|
|
|
|
|
|
|
|
put4(DBL->_s.p1.fract, (char *) &DBL->_s.p1.fract);
|
|
|
|
put4(DBL->_s.p2, (char *) &DBL->_s.p2);
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
1988-07-25 10:46:15 +00:00
|
|
|
else {
|
|
|
|
/*
|
|
|
|
* COMPACT EXTENDED INTO FLOAT
|
|
|
|
*/
|
1988-08-04 18:10:34 +00:00
|
|
|
SINGLE *SGL;
|
|
|
|
|
1988-04-07 10:57:49 +00:00
|
|
|
/* local CAST conversion */
|
|
|
|
SGL = (SINGLE *) to;
|
|
|
|
if ((f->m1 & SGL_ZERO) == 0L) {
|
|
|
|
SGL->fract = 0L;
|
1988-07-25 10:46:15 +00:00
|
|
|
return;
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
|
|
|
f->exp += SGL_BIAS; /* restore bias */
|
|
|
|
if (f->exp > SGL_MAX) {
|
|
|
|
sgl_over: trap(EFOVFL);
|
1989-07-25 14:21:09 +00:00
|
|
|
f->exp = SGL_MAX+1;
|
|
|
|
f->m1 = 0L;
|
1988-08-11 10:28:30 +00:00
|
|
|
f->m2 = 0L;
|
1988-04-07 10:57:49 +00:00
|
|
|
if (error++)
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
else if (f->exp < SGL_MIN) {
|
1989-07-25 14:21:09 +00:00
|
|
|
b64_rsft(&(f->m1));
|
|
|
|
if (f->exp < 0) {
|
|
|
|
b64_sft(&(f->m1), -f->exp);
|
|
|
|
f->exp = 0;
|
|
|
|
}
|
|
|
|
/* underflow ??? */
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
/* shift mantissa and store */
|
|
|
|
SGL->fract = (f->m1 >> SGL_RUNPACK);
|
|
|
|
|
|
|
|
/* check for rounding to nearest */
|
1988-08-04 18:10:34 +00:00
|
|
|
#ifdef EXCEPTION_INEXACT
|
|
|
|
if (f->m2 != 0 ||
|
|
|
|
(f->m1 & SGL_EXACT) != 0L) {
|
|
|
|
INEXACT();
|
|
|
|
#endif
|
1988-04-07 10:57:49 +00:00
|
|
|
if (f->m1 & SGL_ROUNDUP) {
|
|
|
|
SGL->fract++;
|
|
|
|
/* check normal */
|
|
|
|
if (SGL->fract & SGL_CARRYOUT) {
|
|
|
|
SGL->fract >>= 1;
|
|
|
|
f->exp++;
|
|
|
|
}
|
1988-08-04 18:10:34 +00:00
|
|
|
if (f->exp > SGL_MAX)
|
|
|
|
goto sgl_over;
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
1988-08-04 18:10:34 +00:00
|
|
|
#ifdef EXCEPTION_INEXACT
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|
1988-08-04 18:10:34 +00:00
|
|
|
#endif
|
1988-04-07 10:57:49 +00:00
|
|
|
|
1988-07-25 10:46:15 +00:00
|
|
|
/*
|
1988-08-04 18:10:34 +00:00
|
|
|
* STORE EXPONENT AND SIGN:
|
1988-07-25 10:46:15 +00:00
|
|
|
*
|
|
|
|
* 1) clear leading bit of fraction
|
|
|
|
* 2) shift and store exponent
|
|
|
|
*/
|
1988-04-07 10:57:49 +00:00
|
|
|
|
1988-07-25 10:46:15 +00:00
|
|
|
SGL->fract &= SGL_MASK; /* B23-B31 are 0 */
|
1988-08-04 18:10:34 +00:00
|
|
|
SGL->fract |=
|
|
|
|
((long) (f->exp << SGL_EXPSHIFT) << EXP_STORE);
|
|
|
|
if (f->sign)
|
|
|
|
SGL->fract |= CARRYBIT;
|
1988-04-07 10:57:49 +00:00
|
|
|
|
1988-08-04 18:10:34 +00:00
|
|
|
/*
|
|
|
|
* STORE MANTISSA
|
|
|
|
*/
|
1988-04-07 10:57:49 +00:00
|
|
|
|
|
|
|
put4(SGL->fract, (char *) &SGL->fract);
|
1988-08-04 18:10:34 +00:00
|
|
|
}
|
1988-04-07 10:57:49 +00:00
|
|
|
}
|