home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c065 / 1.ddi / CLIB1.ZIP / BCD1.C < prev    next >
Encoding:
C/C++ Source or Header  |  1990-06-07  |  6.1 KB  |  341 lines
  1. /*-----------------------------------------------------------------------*
  2.  * filename - bcd1.c
  3.  * Library for long double / binary code decimal conversions
  4.  *-----------------------------------------------------------------------*/
  5.  
  6. /*[]------------------------------------------------------------[]*/
  7. /*|                                                              |*/
  8. /*|     Turbo C Run Time Library - Version 3.0                   |*/
  9. /*|                                                              |*/
  10. /*|                                                              |*/
  11. /*|     Copyright (c) 1987,1988,1990 by Borland International    |*/
  12. /*|     All Rights Reserved.                                     |*/
  13. /*|                                                              |*/
  14. /*[]------------------------------------------------------------[]*/
  15.  
  16. /*
  17. about 17 digits precision
  18. exponent range, about 1e-125 to 1e+125
  19.  
  20. bcd format:
  21. expo        mantissa        value
  22. 0        0            0
  23. 1        +1 or -1        +INF or -INF
  24. 2        ?            NAN
  25. 3-255        x            x * 10 ^ (expo - Bias)
  26.  
  27. The Bias is 147, so exponent range is 3-147=-144 to 255-147=+108.
  28. Caution: The decimal representation is not unique.
  29. Eg, { 1L, 0L, 1+Bias } is the same as { 10L, 0L, 0+Bias }.
  30. */
  31.  
  32. #pragma  inline
  33.  
  34. typedef unsigned short bits16;
  35.  
  36. typedef struct
  37. {
  38.     bits16      frac [4];
  39.     bits16      signExp;
  40. }
  41.     IEEE80;
  42.  
  43. struct decimal {
  44.     long mantissa[2];
  45.     short expo;
  46. };
  47.  
  48. typedef struct decimal bcd;
  49.  
  50. enum bcdexpo {
  51.     ExpoZero,
  52.     ExpoInf,
  53.     ExpoNan,
  54. };
  55.  
  56. #define Bias    147
  57.  
  58. #define I asm
  59.  
  60. #define REAL    qword ptr
  61. #define REAL1    dword ptr
  62. #define REAL2    qword ptr
  63. #define REAL3    tbyte ptr
  64.  
  65. #define BYTE    byte ptr
  66. #define WORD    word ptr
  67. #define LONG    dword ptr
  68. #define LONG64    qword ptr
  69.  
  70. static const long e0toF [8] =
  71. {
  72.     1, 10, 100, 1000, 10000, 100000L, 1000000L, 10000000L
  73. };
  74.  
  75. static const IEEE80 expo [10] =
  76. {
  77.     {{0,      0,      0x2000, 0xBEBC}, 0x4019},    /* 1e8    */
  78.     {{0,      0x0400, 0xC9BF, 0x8E1B}, 0x4034},    /* 1e16   */
  79.     {{0xB59E, 0x2B70, 0xADA8, 0x9DC5}, 0x4069},    /* 1e32   */
  80.     {{0xA6D5, 0xFFCF, 0x1F49, 0xC278}, 0x40D3},    /* 1e64   */
  81.     {{0x8CE0, 0x80E9, 0x47C9, 0x93BA}, 0x41A8},    /* 1e128  */
  82.     {{0xDE8E, 0x9DF9, 0xEBFB, 0xAA7E}, 0x4351},    /* 1e256  */
  83.     {{0x91C7, 0xA60E, 0xA0AE, 0xE319}, 0x46A3},    /* 1e512  */
  84.     {{0x0C17, 0x8175, 0x7586, 0xC976}, 0x4D48},    /* 1e1024 */
  85.     {{0x5DE5, 0xC53D, 0x3B5D, 0x9E8B}, 0x5A92},    /* 1e2048 */
  86.     {{0x979B, 0x8A20, 0x5202, 0xC460}, 0x7525},    /* 1e4096 */
  87. };
  88.  
  89. static void near pascal scale10(int p)
  90. /* return
  91.     TOS *= 10 ^ p
  92.     preserves ax!
  93. */
  94. {
  95. I    mov    si, p
  96. I    or    si, si
  97. I    mov    dx, si
  98. I    jz    scale_num
  99. I    jns    scale_abs
  100. I    neg    si
  101. scale_abs:
  102. I    cmp    si, 4999
  103. I    jbe    scale_max
  104. I    mov    si, 4999
  105. scale_max:
  106. /* load e0toF[_SI & 7] */
  107. I    mov    bx, 7
  108. I    and    bx, si
  109. I    shl    bx, 1
  110. I    shl    bx, 1
  111. I    add    bx, offset e0toF
  112. I    fild    LONG [bx]
  113.  
  114. I    mov    cl, 3
  115. I    shr    si, cl
  116. I    mov    di, offset expo
  117. expo_loop:
  118. I    or    si, si
  119. I    jz    scale_num
  120. I    shr    si, 1
  121. I    jnc    expo_next
  122. I    fld    REAL3 [di]
  123. I    fmul
  124.  
  125. expo_next:
  126. I    add    di, 10
  127. I    jmp    expo_loop
  128.  
  129. scale_num:
  130. I    or    dx, dx
  131. I    jz    scale_end
  132. I    jns    scale_mul
  133. I    fdiv
  134. I    jmp    short scale_end
  135. scale_mul:
  136. I    fmul
  137.  
  138. scale_end:
  139.     return;
  140. }
  141.  
  142. static const float inf = 1.0/0.0;
  143. static const float nan = 0.0/0.0;
  144.  
  145. /*
  146. Convert a decimal number to binary.
  147. */
  148.  
  149. long double pascal __bcd_tobinary(const bcd far *p)
  150. {
  151. I    les    bx, p
  152. I    fild    LONG64 es:[bx]        /* p->mantissa */
  153. I    mov    ax, es:[bx+8]        /* p->expo */
  154.  
  155. I    cmp    al, 2
  156. I    jbe    special
  157. I    sub    ax, Bias
  158.     scale10(_AX);
  159. I    jmp    short done
  160.  
  161. special:
  162. I    je    nan
  163. I    or    al, al
  164. I    jz    zero
  165.  
  166. I    fmul    REAL1 inf        /* mantissa was +1 or -1 */
  167. I    jmp    short done
  168.  
  169. nan:
  170. I    fstp    st(0)
  171. I    fld    REAL1 nan
  172.     /* fall thru */
  173.  
  174. zero:
  175. /* assume mantissa is 0 */
  176. done:
  177. #pragma warn -rvl    /* Function should return a value */
  178.     return;
  179. #pragma warn .rvl    /* Function should return a value */
  180. }
  181.  
  182. /*
  183. round x to n decimal places
  184. fixed point!
  185. eg,
  186. x = 123.4567;
  187. round(x, 0) = 123.
  188. round(x, 1) = 123.5
  189. round(x, 2) = 123.46
  190. round(x, -1) = 120.
  191. round(x, -2) = 100.
  192.  
  193. uses banker's rounding
  194.  
  195. Convert a binary number to decimals.
  196. Use at most 'decimals' after the decimal point.
  197. For maximum accuracy, use decimals=5000.
  198. */
  199.  
  200. void pascal __bcd_todecimal(long double x, int decimals, bcd far *p)
  201. {
  202. I    mov    ax, x[8]
  203. I    mov    dx, x[6]
  204. I    mov    cx, 7FFFh
  205. I    les    si, p
  206.  
  207. I    and    ax, cx
  208. I    jz    zero
  209. I    cmp    ax, cx
  210. I    je    special
  211.  
  212. I    sub    ax, 3FFFh + 60
  213. I    neg    ax
  214.  
  215. #if 0
  216. I    shl    dx, 1
  217. I    shl    dx, 1
  218. I    rcl    ax, 1
  219. I    shl    dx, 1
  220. I    rcl    ax, 1
  221.  
  222. I    mov    dx, 92A0h shr 1
  223. I    imul    dx
  224.  
  225. I    xchg    ax, dx
  226. I    sar    ax, 1
  227. I    sar    ax, 1
  228.  
  229. #else
  230. I    mov    dx, 9A20h shr 1    /* log10(2) */
  231. I    imul    dx
  232. I    xchg    ax, dx
  233. #endif
  234.  
  235. /* use min(ax,n) */
  236. I    mov    dx, decimals
  237. I    cmp    ax, dx
  238. I    jl    min
  239. I    xchg    ax, dx
  240. min:
  241.  
  242. /* -ax is unbiased exponent, not special, so -144 <= -ax <= 108 */
  243. I    cmp    ax, +144
  244. I    jg    underflow
  245. I    cmp    ax, -108
  246. I    jl    overflow
  247.  
  248. I    fld    REAL3 x
  249.     scale10(_AX);
  250.  
  251. I    neg    ax
  252. I    add    ax, Bias
  253. I    jmp    short done
  254.  
  255. special:
  256. I    or    dx, dx
  257. I    jz    nan
  258.  
  259. overflow:
  260. I    fld1
  261. I    mov    al, ExpoInf
  262. I    test    BYTE x[9], 80h
  263. I    jz    done
  264. I    fchs
  265. I    jmp    short done
  266.  
  267. nan:
  268. I    fldz
  269. I    mov    al, ExpoNan
  270. I    jmp    short done
  271.  
  272. underflow:
  273. zero:
  274. I    fldz
  275. I    mov    al, ExpoZero
  276.  
  277. done:
  278. I    fistp    LONG64 es:[si]
  279. I    mov    ah, 0
  280. I    mov    es:[si+8], ax
  281. I    fwait
  282. }
  283.  
  284. #if    DEBUG
  285. /* for debugging */
  286. long double pascal load64(long far *a)
  287. {
  288. I    les    bx, a
  289. I    fild    LONG64 es:[bx]
  290.     return;
  291. }
  292. #endif
  293.  
  294. /* from _mathl.h */
  295. typedef enum {
  296.     _Sine_,_CoSine_,_Tangent_,_ArcTan_,
  297.     _Log_,_Log2_, _Log10_,
  298.     _Exp_,_Exp2_, _Exp10_,_Power_
  299. } FLIB_functions;
  300.  
  301. #define FLIB_(fun)    _FAST_(0ECh + 2*fun)
  302. #define _FAST_(shortCode)    int    3Eh;  asm db    shortCode, 90h
  303.  
  304. #pragma warn -rvl
  305. long double pascal __bcd_log10(bcd far *p)
  306. {
  307. I    les    bx, p
  308. I    fild    LONG64 es:[bx]
  309. asm    FLIB_    (_Log10_)
  310. I    sub    WORD es:[bx+8], Bias
  311. I    fiadd    WORD es:[bx+8]
  312. I    add    WORD es:[bx+8], Bias
  313. I    fwait
  314.     return;
  315. }
  316. #pragma warn .rvl
  317.  
  318. void pascal __bcd_pow10(int n, bcd far *p)
  319. {
  320.     p->mantissa[0] = 1;
  321.     p->mantissa[1] = 0;
  322.     _AX = n;
  323. I    add    ax, Bias
  324. I    cmp    ax, 255
  325. I    jg    inf
  326. I    cmp    ax, 3
  327. I    jl    zero
  328.     p->expo = _AX;
  329.     return;
  330.  
  331. zero:
  332.     p->mantissa[0] = 0;
  333.     p->expo = 0;
  334.     return;
  335.  
  336. inf:
  337.     p->expo = ExpoInf;
  338.     return;
  339. }
  340.  
  341.