|
|
1.1 ! root 1: /* real2prim.c - real to presentation element */ ! 2: ! 3: #ifndef lint ! 4: static char *rcsid = "$Header: /f/osi/psap/RCS/real2prim.c,v 7.0 89/11/23 22:13:34 mrose Rel $"; ! 5: #endif ! 6: ! 7: /* ! 8: * $Header: /f/osi/psap/RCS/real2prim.c,v 7.0 89/11/23 22:13:34 mrose Rel $ ! 9: * ! 10: * Contributed by Julian Onions, Nottingham University. ! 11: * July 1989 - this is awful stuff! ! 12: * ! 13: 8 ! 14: * $Log: real2prim.c,v $ ! 15: * Revision 7.0 89/11/23 22:13:34 mrose ! 16: * Release 6.0 ! 17: * ! 18: */ ! 19: ! 20: /* ! 21: * NOTICE ! 22: * ! 23: * Acquisition, use, and distribution of this module and related ! 24: * materials are subject to the restrictions of a license agreement. ! 25: * Consult the Preface in the User's Manual for the full terms of ! 26: * this agreement. ! 27: * ! 28: */ ! 29: ! 30: ! 31: /* LINTLIBRARY */ ! 32: ! 33: #include "psap.h" ! 34: ! 35: /* */ ! 36: ! 37: PE real2prim (d, class, id) ! 38: register double d; ! 39: PElementClass class; ! 40: PElementID id; ! 41: { ! 42: register PE pe; ! 43: double mant, nm; ! 44: int exponent; ! 45: int expsign; ! 46: int parts[sizeof (double)]; ! 47: int sign, i, maxi, mask; ! 48: int n, explen; ! 49: PElementData dp; ! 50: ! 51: if ((pe = pe_alloc (class, PE_FORM_PRIM, id)) == NULLPE) ! 52: return NULLPE; ! 53: ! 54: if (d == 0.0) ! 55: return pe; ! 56: ! 57: mant = frexp (d, &exponent); ! 58: ! 59: if (mant < 0.0) { ! 60: sign = -1; ! 61: mant = -mant; ! 62: } ! 63: else sign = 1; ! 64: ! 65: nm = mant; ! 66: for (i = 0; i < sizeof (double) ; i++) { ! 67: int intnm; ! 68: nm *= (1<<8); ! 69: intnm = ((int)nm) & 0xff; ! 70: nm -= intnm; ! 71: if (intnm) ! 72: maxi = i + 1; ! 73: parts[i] = intnm; ! 74: } ! 75: ! 76: exponent -= 8 * maxi; ! 77: ! 78: expsign = exponent >= 0 ? exponent : exponent ^ (-1); ! 79: mask = 0x1ff << (((n = sizeof exponent) - 1) * 8 - 1); ! 80: while (n > 1 && (expsign & mask) == 0) ! 81: mask >>= 8, n--; ! 82: ! 83: explen = n; ! 84: if (n > 3) ! 85: n ++; ! 86: ! 87: if ((pe -> pe_prim = PEDalloc (n + maxi + 1)) == NULLPED) { ! 88: pe_free (pe); ! 89: return NULLPE; ! 90: } ! 91: ! 92: dp = pe -> pe_prim + (pe -> pe_len = n + maxi + 1); ! 93: ! 94: for (; maxi > 0; maxi --) ! 95: *--dp = parts[maxi - 1]; ! 96: for (n = explen; n-- > 0; exponent >>= 8) ! 97: *--dp = exponent & 0xff; ! 98: if (explen > 3) ! 99: *--dp = explen & 0xff; ! 100: ! 101: switch (explen) { ! 102: case 1: ! 103: explen = PE_REAL_B_EF1; ! 104: break; ! 105: case 2: ! 106: explen = PE_REAL_B_EF2; ! 107: break; ! 108: case 3: ! 109: explen = PE_REAL_B_EF3; ! 110: break; ! 111: default: ! 112: explen = PE_REAL_B_EF3; ! 113: break; ! 114: } ! 115: *--dp = PE_REAL_BINENC ! 116: | PE_REAL_B_B2 ! 117: | (sign == -1 ? PE_REAL_B_S : 0) ! 118: | explen; ! 119: return pe; ! 120: } ! 121: ! 122: ! 123: ! 124:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.