123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202 |
- /*
- (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
- See the copyright notice in the ACK home directory, in the file "Copyright".
- */
- /* $Id$ */
- /*
- 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"
- void
- compact(f,to,size)
- EXTEND *f;
- unsigned long *to;
- int size;
- {
- int error = 0;
- if (size == sizeof(DOUBLE)) {
- /*
- * COMPACT EXTENDED INTO DOUBLE
- */
- DOUBLE *DBL = (DOUBLE *) (void *) to;
- if ((f->m1|(f->m2 & DBL_ZERO)) == 0L) {
- zrf8(DBL);
- return;
- }
- f->exp += DBL_BIAS; /* restore proper bias */
- if (f->exp > DBL_MAX) {
- dbl_over: trap(EFOVFL);
- f->exp = DBL_MAX+1;
- f->m1 = 0;
- f->m2 = 0;
- if (error++)
- return;
- }
- else if (f->exp < DBL_MIN) {
- b64_rsft(&(f->mantissa));
- if (f->exp < 0) {
- b64_sft(&(f->mantissa), -f->exp);
- f->exp = 0;
- }
- /* underflow ??? */
- }
-
- /* local CAST conversion */
- /* because of special format shift only 10 bits */
- /* bit shift mantissa 10 bits */
- /* first align within words, then do store operation */
- DBL->d[0] = f->m1 >> DBL_RUNPACK; /* plus 22 == 32 */
- DBL->d[1] = f->m2 >> DBL_RUNPACK; /* plus 22 == 32 */
- DBL->d[1] |= (f->m1 << DBL_LUNPACK); /* plus 10 == 32 */
- /* if not exact then round to nearest */
- /* on a tie, round to even */
- #ifdef EXCEPTION_INEXACT
- if ((f->m2 & DBL_EXACT) != 0) {
- INEXACT();
- #endif
- if (((f->m2 & DBL_EXACT) > DBL_ROUNDUP)
- || ((f->m2 & DBL_EXACT) == DBL_ROUNDUP
- && (f->m2 & (DBL_ROUNDUP << 1)))) {
- DBL->d[1]++; /* rounding up */
- if (DBL->d[1] == 0L) { /* carry out */
- DBL->d[0]++;
- if (f->exp == 0 && (DBL->d[0] & ~DBL_MASK)) {
- f->exp++;
- }
- if (DBL->d[0] & DBL_CARRYOUT) { /* carry out */
- if (DBL->d[0] & 01)
- DBL->d[1] = CARRYBIT;
- DBL->d[0] >>= 1;
- f->exp++;
- }
- }
- /* check for overflow */
- if (f->exp > DBL_MAX)
- goto dbl_over;
- }
- #ifdef EXCEPTION_INEXACT
- }
- #endif
- /*
- * STORE EXPONENT AND SIGN:
- *
- * 1) clear leading bits (B4-B15)
- * 2) shift and store exponent
- */
- DBL->d[0] &= DBL_MASK;
- DBL->d[0] |=
- ((long) (f->exp << DBL_EXPSHIFT) << EXP_STORE);
- if (f->sign)
- DBL->d[0] |= CARRYBIT;
- /*
- * STORE MANTISSA
- */
- #if FL_MSL_AT_LOW_ADDRESS
- put4(DBL->d[0], (char *) &DBL->d[0]);
- put4(DBL->d[1], (char *) &DBL->d[1]);
- #else
- { unsigned long l;
- put4(DBL->d[1], (char *) &l);
- put4(DBL->d[0], (char *) &DBL->d[1]);
- DBL->d[0] = l;
- }
- #endif
- }
- else {
- /*
- * COMPACT EXTENDED INTO FLOAT
- */
- SINGLE *SGL;
- /* local CAST conversion */
- SGL = (SINGLE *) (void *) to;
- if ((f->m1 & SGL_ZERO) == 0L) {
- *SGL = 0L;
- return;
- }
- f->exp += SGL_BIAS; /* restore bias */
- if (f->exp > SGL_MAX) {
- sgl_over: trap(EFOVFL);
- f->exp = SGL_MAX+1;
- f->m1 = 0L;
- f->m2 = 0L;
- if (error++)
- return;
- }
- else if (f->exp < SGL_MIN) {
- b64_rsft(&(f->mantissa));
- if (f->exp < 0) {
- b64_sft(&(f->mantissa), -f->exp);
- f->exp = 0;
- }
- /* underflow ??? */
- }
- /* shift mantissa and store */
- *SGL = (f->m1 >> SGL_RUNPACK);
- /* check for rounding to nearest */
- /* on a tie, round to even */
- #ifdef EXCEPTION_INEXACT
- if (f->m2 != 0 ||
- (f->m1 & SGL_EXACT) != 0L) {
- INEXACT();
- #endif
- if (((f->m1 & SGL_EXACT) > SGL_ROUNDUP)
- || ((f->m1 & SGL_EXACT) == SGL_ROUNDUP
- && (f->m1 & (SGL_ROUNDUP << 1)))) {
- (*SGL)++;
- if (f->exp == 0 && (*SGL & ~SGL_MASK)) {
- f->exp++;
- }
- /* check normal */
- if (*SGL & SGL_CARRYOUT) {
- *SGL >>= 1;
- f->exp++;
- }
- if (f->exp > SGL_MAX)
- goto sgl_over;
- }
- #ifdef EXCEPTION_INEXACT
- }
- #endif
- /*
- * STORE EXPONENT AND SIGN:
- *
- * 1) clear leading bit of fraction
- * 2) shift and store exponent
- */
- *SGL &= SGL_MASK; /* B23-B31 are 0 */
- *SGL |= ((long) (f->exp << SGL_EXPSHIFT) << EXP_STORE);
- if (f->sign)
- *SGL |= CARRYBIT;
- /*
- * STORE MANTISSA
- */
- put4(*SGL, (char *) &SGL);
- }
- }
|