![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to real.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / engine|
Return to real.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / engine |
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/engine/real.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "base.h"
! 4: #include <math.h>
! 5:
! 6: #if defined(THINK_C)
! 7: double RatnToReal(a)
! 8: Q a;
! 9: {
! 10: double nm,dn,t;
! 11: int enm,edn;
! 12: char buf[BUFSIZ];
! 13:
! 14: nm = NatToReal(NM(a),&enm);
! 15: if ( INT(a) )
! 16: if ( enm >= 1 )
! 17: error("RatnToReal : Overflow");
! 18: else
! 19: return SGN(a)>0 ? nm : -nm;
! 20: else {
! 21: dn = NatToReal(DN(a),&edn);
! 22: sprintf(buf,"1.0E%d",enm-edn);
! 23: sscanf(buf,"%lf",&t);
! 24: if ( SGN(a) < 0 )
! 25: t = -t;
! 26: return nm/dn*t;
! 27: }
! 28: }
! 29:
! 30: double NatToReal(a,expo)
! 31: N a;
! 32: int *expo;
! 33: {
! 34: int *p;
! 35: int l,all,i,j,s,tb,top,tail;
! 36: unsigned int t,m[2];
! 37:
! 38: p = BD(a); l = PL(a) - 1;
! 39: for ( top = 0, t = p[l]; t; t >>= 1, top++ );
! 40: all = top + BSH*l; tail = (53-top)%BSH; i = l-(53-top)/BSH-1;
! 41: m[1] = i < 0 ? 0 : p[i]>>(BSH-tail);
! 42: for ( j = 1, i++, tb = tail; i <= l; i++ ) {
! 43: s = 32-tb; t = i < 0 ? 0 : p[i];
! 44: if ( BSH > s ) {
! 45: m[j] |= ((t&((1<<s)-1))<<tb);
! 46: if ( !j )
! 47: break;
! 48: else {
! 49: j--; m[j] = t>>s; tb = BSH-s;
! 50: }
! 51: } else {
! 52: m[j] |= (t<<tb); tb += BSH;
! 53: }
! 54: }
! 55: s = (all-1)+1023;
! 56: m[0] = (m[0]&((1<<20)-1))|(MIN(2046,s)<<20); *expo = MAX(s-2046,0);
! 57: #ifdef vax
! 58: t = m[0]; m[0] = m[1]; m[1] = t; itod(m);
! 59: #endif
! 60: #if defined(MIPSEL)
! 61: t = m[0]; m[0] = m[1]; m[1] = t;
! 62: #endif
! 63: return (double)(*((short double *)m));
! 64: }
! 65: #else
! 66: double RatnToReal(a)
! 67: Q a;
! 68: {
! 69: double nm,dn,t,man;
! 70: int enm,edn,e;
! 71: unsigned int *p,s;
! 72:
! 73: nm = NatToReal(NM(a),&enm);
! 74: if ( INT(a) )
! 75: if ( enm >= 1 )
! 76: error("RatnToReal : Overflow");
! 77: else
! 78: return SGN(a)>0 ? nm : -nm;
! 79: else {
! 80: dn = NatToReal(DN(a),&edn);
! 81: man = nm/dn;
! 82: if ( SGN(a) < 0 )
! 83: man = -man;
! 84: if ( ((e = enm - edn) >= 1024) || (e <= -1023) )
! 85: error("RatnToReal : Overflow"); /* XXX */
! 86: else if ( !e )
! 87: return man;
! 88: else
! 89: return man*pow(2,e);
! 90: }
! 91: }
! 92:
! 93: double NatToReal(a,expo)
! 94: N a;
! 95: int *expo;
! 96: {
! 97: unsigned int *p;
! 98: int l,all,i,j,s,tb,top,tail;
! 99: unsigned int t,m[2];
! 100:
! 101: p = BD(a); l = PL(a) - 1;
! 102: for ( top = 0, t = p[l]; t; t >>= 1, top++ );
! 103: all = top + BSH*l; tail = (53-top)%BSH; i = l-(53-top)/BSH-1;
! 104: m[1] = i < 0 ? 0 : p[i]>>(BSH-tail);
! 105: for ( j = 1, i++, tb = tail; i <= l; i++ ) {
! 106: s = 32-tb; t = i < 0 ? 0 : p[i];
! 107: if ( BSH > s ) {
! 108: m[j] |= ((t&((1<<s)-1))<<tb);
! 109: if ( !j )
! 110: break;
! 111: else {
! 112: j--; m[j] = t>>s; tb = BSH-s;
! 113: }
! 114: } else {
! 115: m[j] |= (t<<tb); tb += BSH;
! 116: }
! 117: }
! 118: s = (all-1)+1023;
! 119: m[0] = (m[0]&((1<<20)-1))|(MIN(2046,s)<<20); *expo = MAX(s-2046,0);
! 120: #ifdef vax
! 121: t = m[0]; m[0] = m[1]; m[1] = t; itod(m);
! 122: #endif
! 123: #if defined(i386) || defined(MIPSEL) || defined(VISUAL) || defined(linux) || defined(__alpha) || defined(__FreeBSD__) || defined(__NetBSD__)
! 124: t = m[0]; m[0] = m[1]; m[1] = t;
! 125: #endif
! 126: return *((double *)m);
! 127: }
! 128: #endif
! 129:
! 130: void addreal(a,b,c)
! 131: Num a,b;
! 132: Real *c;
! 133: {
! 134: double t;
! 135:
! 136: t = ToReal(a)+ToReal(b); MKReal(t,*c);
! 137: }
! 138:
! 139: void subreal(a,b,c)
! 140: Num a,b;
! 141: Real *c;
! 142: {
! 143: double t;
! 144:
! 145: t = ToReal(a)-ToReal(b); MKReal(t,*c);
! 146: }
! 147:
! 148: void mulreal(a,b,c)
! 149: Num a,b;
! 150: Real *c;
! 151: {
! 152: double t;
! 153:
! 154: if ( !a || !b )
! 155: *c = 0;
! 156: else {
! 157: t = ToReal(a)*ToReal(b);
! 158: if ( !t )
! 159: error("mulreal : Underflow"); /* XXX */
! 160: else
! 161: MKReal(t,*c);
! 162: }
! 163: }
! 164:
! 165: void divreal(a,b,c)
! 166: Num a,b;
! 167: Real *c;
! 168: {
! 169: double t;
! 170:
! 171: if ( !a )
! 172: *c = 0;
! 173: else {
! 174: t = ToReal(a)/ToReal(b);
! 175: if ( !t )
! 176: error("divreal : Underflow"); /* XXX */
! 177: else
! 178: MKReal(t,*c);
! 179: }
! 180: }
! 181:
! 182: void chsgnreal(a,c)
! 183: Num a,*c;
! 184: {
! 185: double t;
! 186: Real s;
! 187:
! 188: if ( !a )
! 189: *c = 0;
! 190: else if ( NID(a) == N_Q )
! 191: chsgnq((Q)a,(Q *)c);
! 192: else {
! 193: t = -ToReal(a); MKReal(t,s); *c = (Num)s;
! 194: }
! 195: }
! 196:
! 197: void pwrreal(a,b,c)
! 198: Num a,b;
! 199: Real *c;
! 200: {
! 201: double t;
! 202: double pwrreal0();
! 203:
! 204: if ( !b )
! 205: MKReal(1.0,*c);
! 206: else if ( !a )
! 207: *c = 0;
! 208: else if ( !RATN(b) || !INT(b) || (PL(NM((Q)b)) > 1) ) {
! 209: t = (double)pow((double)ToReal(a),(double)ToReal(b));
! 210: if ( !t )
! 211: error("pwrreal : Underflow"); /* XXX */
! 212: else
! 213: MKReal(t,*c);
! 214: } else {
! 215: t = pwrreal0(BDY((Real)a),BD(NM((Q)b))[0]);
! 216: t = SGN((Q)b)>0?t:1/t;
! 217: if ( !t )
! 218: error("pwrreal : Underflow"); /* XXX */
! 219: else
! 220: MKReal(t,*c);
! 221: }
! 222: }
! 223:
! 224: double pwrreal0(n,e)
! 225: double n;
! 226: int e;
! 227: {
! 228: double t;
! 229:
! 230: if ( e == 1 )
! 231: return n;
! 232: else {
! 233: t = pwrreal0(n,e / 2);
! 234: return e%2 ? t*t*n : t*t;
! 235: }
! 236: }
! 237:
! 238: int cmpreal(a,b)
! 239: Real a,b;
! 240: {
! 241: double t;
! 242:
! 243: t = ToReal(a)-ToReal(b);
! 244: return t>0.0 ? 1 : t<0.0?-1 : 0;
! 245: }