home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / commercial-software / programming / AZTEC302.ZIP / MATH.ARC < prev    next >
Text File  |  1998-09-16  |  72KB  |  4,420 lines
  1. asin.c
  2. #include "math.h"
  3. #include "errno.h"
  4.  
  5. double arcsine();
  6.  
  7. double asin(x)
  8. double x;
  9. {
  10.     return arcsine(x,0);
  11. }
  12.  
  13. double acos(x)
  14. double x;
  15. {
  16.     return arcsine(x,1);
  17. }
  18.  
  19. #define P1 -0.27368494524164255994e+2
  20. #define P2 +0.57208227877891731407e+2
  21. #define P3 -0.39688862997504877339e+2
  22. #define P4 +0.10152522233806463645e+2
  23. #define P5 -0.69674573447350646411
  24. #define Q0 -0.16421096714498560795e+3
  25. #define Q1 +0.41714430248260412556e+3
  26. #define Q2 -0.38186303361750149284e+3
  27. #define Q3 +0.15095270841030604719e+3
  28. #define Q4 -0.23823859153670238830e+2
  29.  
  30. #define P(g) ((((P5*g P4)*g P3)*g P2)*g P1)
  31. #define Q(g) (((((g Q4)*g Q3)*g Q2)*g Q1)*g Q0)
  32.  
  33. double arcsine(x,flg)
  34. double x;
  35. {
  36.     double y, g, r;
  37.     register int i;
  38.     extern int errno;
  39.     static double a[2] = { 0.0, 0.78539816339744830962 };
  40.     static double b[2] = { 1.57079632679489661923, 0.78539816339744830962 };
  41.  
  42.     y = fabs(x);
  43.     i = flg;
  44.     if (y < 2.3e-10)
  45.         r = y;
  46.     else {
  47.         if (y > 0.5) {
  48.             i = 1-i;
  49.             if (y > 1.0) {
  50.                 errno = EDOM;
  51.                 return 0.0;
  52.             }
  53.             g = (0.5-y)+0.5;
  54.             g = ldexp(g,-1);
  55.             y = sqrt(g);
  56.             y = -(y+y);
  57.         } else
  58.             g = y*y;
  59.         r = y + y*
  60.                 ((P(g)*g)
  61.                 /Q(g));
  62.     }
  63.     if (flg) {
  64.         if (x < 0.0)
  65.             r = (b[i] + r) + b[i];
  66.         else
  67.             r = (a[i] - r) + a[i];
  68.     } else {
  69.         r = (a[i] + r) + a[i];
  70.         if (x < 0.0)
  71.             r = -r;
  72.     }
  73.     return r;
  74. }
  75. atan.c
  76. #include "math.h"
  77. #include "errno.h"
  78.  
  79. #ifdef MPU8086
  80. #define MAXEXP    1024
  81. #define MINEXP    -1023
  82. #else
  83. #define MAXEXP    504
  84. #define MINEXP    -512
  85. #endif
  86.  
  87. #define PI        3.14159265358979323846
  88. #define PIov2    1.57079632679489661923
  89.  
  90. double atan2(v,u)
  91. double u,v;
  92. {
  93.     double f, frexp();
  94.     int vexp, uexp;
  95.     extern int flterr;
  96.     extern int errno;
  97.  
  98.     if (u == 0.0) {
  99.         if (v == 0.0) {
  100.             errno = EDOM;
  101.             return 0.0;
  102.         }
  103.         return PIov2;
  104.     }
  105.  
  106.     frexp(v, &vexp);
  107.     frexp(u, &uexp);
  108.     if (vexp-uexp > MAXEXP-3)    /* overflow */
  109.         f = PIov2;
  110.     else {
  111.         if (vexp-uexp < MINEXP+3)    /* underflow */
  112.             f = 0.0;
  113.         else
  114.             f = atan(fabs(v/u));
  115.         if (u < 0.0)
  116.             f = PI - f;
  117.     }
  118.     if (v < 0.0)
  119.         f = -f;
  120.     return f;
  121. }
  122.  
  123. #define P0 -0.13688768894191926929e+2
  124. #define P1 -0.20505855195861651981e+2
  125. #define P2 -0.84946240351320683534e+1
  126. #define P3 -0.83758299368150059274e+0
  127. #define Q0 +0.41066306682575781263e+2
  128. #define Q1 +0.86157349597130242515e+2
  129. #define Q2 +0.59578436142597344465e+2
  130. #define Q3 +0.15024001160028576121e+2
  131.  
  132. #define P(g) (((P3*g P2)*g P1)*g P0)
  133. #define Q(g) ((((g Q3)*g Q2)*g Q1)*g Q0)
  134.  
  135. double atan(x)
  136. double x;
  137. {
  138.     double f, r, g;
  139.     int n;
  140.     static double Avals[4] = {
  141.         0.0,
  142.         0.52359877559829887308,
  143.         1.57079632679489661923,
  144.         1.04719755119659774615
  145.     };
  146.     
  147.     n = 0;
  148.     f = fabs(x);
  149.     if (f > 1.0) {
  150.         f = 1.0/f;
  151.         n = 2;
  152.     }
  153.     if (f > 0.26794919243112270647) {
  154.         f = (((0.73205080756887729353*f - 0.5) - 0.5) + f) /
  155.                 (1.73205080756887729353 + f);
  156.         ++n;
  157.     }
  158.     if (fabs(f) < 2.3e-10)
  159.         r = f;
  160.     else {
  161.         g = f*f;
  162.         r = f + f *
  163.             ((P(g)*g)
  164.             /Q(g));
  165.     }
  166.     if (n > 1)
  167.         r = -r;
  168.     r += Avals[n];
  169.     if (x < 0.0)
  170.         r = -r;
  171.     return r;
  172. }
  173. exp.c
  174. #include "math.h"
  175. #include "errno.h"
  176.  
  177. #define P0 0.249999999999999993e+0
  178. #define P1 0.694360001511792852e-2
  179. #define P2 0.165203300268279130e-4
  180. #define Q0 0.500000000000000000e+0
  181. #define Q1 0.555538666969001188e-1
  182. #define Q2 0.495862884905441294e-3
  183.  
  184. #define P(z) ((P2*z + P1)*z + P0)
  185. #define Q(z) ((Q2*z + Q1)*z + Q0)
  186.  
  187. #define EPS    2.710505e-20
  188.  
  189. double
  190. exp(x)
  191. double x;
  192. {
  193.     int n;
  194.     double xn, g, r, z;
  195.     extern int errno;
  196.     
  197.     if (x > LOGHUGE) {
  198.         errno = ERANGE;
  199.         return HUGE_VAL;
  200.     }
  201.     if (x < LOGTINY) {
  202.         errno = ERANGE;
  203.         return 0.0;
  204.     }
  205.     if (fabs(x) < EPS)
  206.         return 1.0;
  207.     n = z = x * 1.4426950408889634074;
  208.     if (n < 0)
  209.         --n;
  210.     if (z-n >= 0.5)
  211.         ++n;
  212.     xn = n;
  213.     g = ((x - xn*0.693359375)) + xn*2.1219444005469058277e-4;
  214.     z = g*g;
  215.     r = P(z)*g;
  216.     r = 0.5 + r/(Q(z)-r);
  217.     return ldexp(r,n+1);
  218. }
  219. floor.c
  220. #include "math.h"
  221.  
  222. double floor(d)
  223. double d;
  224. {
  225.     if (d < 0.0)
  226.         return -ceil(-d);
  227.     modf(d, &d);
  228.     return d;
  229. }
  230.  
  231. double ceil(d)
  232. double d;
  233. {
  234.     if (d < 0.0)
  235.         return -floor(-d);
  236.     if (modf(d, &d) > 0.0)
  237.         ++d;
  238.     return d;
  239. }
  240. log.c
  241. #include "math.h"
  242. #include "errno.h"
  243.  
  244. double log10(x)
  245. double x;
  246. {
  247.     return log(x)*0.43429448190325182765;
  248. }
  249.  
  250. #define A0 -0.64124943423745581147e+2
  251. #define A1 +0.16383943563021534222e+2
  252. #define A2 -0.78956112887491257267e+0
  253. #define A(w) ((A2*w A1)*w A0)
  254.  
  255. #define B0 -0.76949932108494879777e+3
  256. #define B1 +0.31203222091924532844e+3
  257. #define B2 -0.35667977739034646171e+2
  258. #define B(w) (((w B2)*w B1)*w B0)
  259.  
  260. #define C0 0.70710678118654752440
  261. #define C1 0.693359375
  262. #define C2 -2.121944400546905827679e-4
  263.  
  264. double log(x)
  265. double x;
  266. {
  267.     double Rz, f, z, w, znum, zden, xn;
  268.     int n;
  269.     extern int errno;
  270.     
  271.     if (x <= 0.0) {
  272.         errno = EDOM;
  273.         return -HUGE_VAL;
  274.     }
  275.     f = frexp(x, &n);
  276.     if (f > C0) {
  277.         znum = (znum = f-0.5) - 0.5; /* the assignment prevents const. eval */
  278.         zden = f*0.5 + 0.5;
  279.     } else {
  280.         --n;
  281.         znum = f - 0.5;
  282.         zden = znum*0.5 + 0.5;
  283.     }
  284.     z = znum/zden;
  285.     w = z*z;
  286. /* the lines below are split up to allow expansion of A(w) and B(w) */
  287.     Rz = z + z * (w *
  288.              A(w)
  289.             /B(w));
  290.     xn = n;
  291.     return (xn*C2 + Rz) + xn*C1;
  292. }
  293. pow.c
  294. #include "math.h"
  295. #include "errno.h"
  296.  
  297. double pow(a,b)
  298. double a,b;
  299. {
  300.     double loga;
  301.     extern int errno;
  302.     
  303.     if (a<=0.0) {
  304.         if (a<0.0 || a==0.0 && b<=0.0) {
  305.             errno = EDOM;
  306.             return -HUGE_VAL;
  307.         }
  308.         else return 0.0;
  309.     }
  310.     loga = log(a);
  311.     loga *= b;
  312.     if (loga > LOGHUGE) {
  313.         errno = ERANGE;
  314.         return HUGE_VAL;
  315.     }
  316.     if (loga < LOGTINY) {
  317.         errno = ERANGE;
  318.         return 0.0;
  319.     }
  320.     return exp(loga);
  321. }
  322. random.c
  323. /*
  324.  * Random number generator -
  325.  * adapted from the FORTRAN version 
  326.  * in "Software Manual for the Elementary Functions"
  327.  * by W.J. Cody, Jr and William Waite.
  328.  */
  329. double ran()
  330. {
  331.     static long int iy = 100001;
  332.     
  333.     iy *= 125;
  334.     iy -= (iy/2796203) * 2796203;
  335.     return (double) iy/ 2796203.0;
  336. }
  337.  
  338. double randl(x)
  339. double x;
  340. {
  341.     double exp();
  342.  
  343.     return exp(x*ran());
  344. }
  345. sin.c
  346. #include "math.h"
  347. #include "errno.h"
  348.  
  349. double cos(x)
  350. double x;
  351. {
  352.     double sincos();
  353.  
  354.     return sincos(x, fabs(x) + 1.57079632679489661923, 0);
  355. }
  356.  
  357. double sin(x)
  358. double x;
  359. {
  360.     double sincos();
  361.     
  362.     if (x < 0.0)
  363.         return sincos(x,-x,1);
  364.     else
  365.         return sincos(x,x,0);
  366. }
  367.  
  368. #define R1 -0.16666666666666665052e+00
  369. #define R2 +0.83333333333331650314e-02
  370. #define R3 -0.19841269841201840457e-03
  371. #define R4 +0.27557319210152756119e-05
  372. #define R5 -0.25052106798274584544e-07
  373. #define R6 +0.16058936490371589114e-09
  374. #define R7 -0.76429178068910467734e-12
  375. #define R8 +0.27204790957888846175e-14
  376.  
  377. #define YMAX 6.7465e09
  378.  
  379. static double sincos(x,y,sgn)
  380. double x,y;
  381. {
  382.     double f, xn, r, g;
  383.     extern int errno;
  384.  
  385.     if (y >= YMAX) {
  386.         errno = ERANGE;
  387.         return 0.0;
  388.     }
  389.     if (modf(y * 0.31830988618379067154, &xn) >= 0.5)
  390.         ++xn;
  391.     if ((int)xn & 1)
  392.         sgn = !sgn;
  393.     if (fabs(x) != y)
  394.         xn -= 0.5;
  395.     g = modf(fabs(x), &x);        /* break into fraction and integer parts */
  396.     f = ((x - xn*3.1416015625) + g) + xn*8.9089102067615373566e-6;
  397.     if (fabs(f) > 2.3283e-10) {
  398.         g = f*f;
  399.         r = (((((((R8*g R7)*g R6)*g R5)*g
  400.                 R4)*g R3)*g R2)*g R1)*g;
  401.         f += f*r;
  402.     }
  403.     if (sgn)
  404.         f = -f;
  405.     return f;
  406. }
  407. sinh.c
  408. #include "math.h"
  409. #include "errno.h"
  410.  
  411. extern int errno;
  412.  
  413. #define P0 -0.35181283430177117881e+6
  414. #define P1 -0.11563521196851768270e+5
  415. #define P2 -0.16375798202630751372e+3
  416. #define P3 -0.78966127417357099479e+0
  417. #define Q0 -0.21108770058106271242e+7
  418. #define Q1 +0.36162723109421836460e+5
  419. #define Q2 -0.27773523119650701667e+3
  420.  
  421. #define PS(x) (((P3*x P2)*x P1)*x P0)
  422. #define QS(x) (((x Q2)*x Q1)*x Q0)
  423.  
  424. double sinh(x)
  425. double x;
  426. {
  427.     double y, w, z;
  428.     int sign;
  429.     
  430.     y = x;
  431.     sign = 0;
  432.     if (x < 0.0) {
  433.         y = -x;
  434.         sign = 1;
  435.     }
  436.     if (y > 1.0) {
  437.         w = y - 0.6931610107421875000;
  438.         if (w > LOGHUGE) {
  439.             errno = ERANGE;
  440.             z = HUGE_VAL;
  441.         } else {
  442.             z = exp(w);
  443.             if (w < 19.95)
  444.                 z -= 0.24999308500451499336 / z;
  445.             z += 0.13830277879601902638e-4 * z;
  446.         }
  447.         if (sign)
  448.             z = -z;
  449.     } else if (y < 2.3e-10)
  450.         z = x;
  451.     else {
  452.         z = x*x;
  453.         z = x + x *
  454.                 (z*(PS(z)
  455.                 /QS(z)));
  456.     }
  457.     return z;
  458. }
  459.  
  460. double cosh(x)
  461. double x;
  462. {
  463.     double y, w, z;
  464.     
  465.     y = fabs(x);
  466.     if (y > 1.0) {
  467.         w = y - 0.6931610107421875000;
  468.         if (w > LOGHUGE) {
  469.             errno = ERANGE;
  470.             return HUGE_VAL;
  471.         }
  472.         z = exp(w);
  473.         if (w < 19.95)
  474.             z += 0.24999308500451499336 / z;
  475.         z += 0.13830277879601902638e-4 * z;
  476.     } else {
  477.         z = exp(y);
  478.         z = z*0.5 + 0.5/z;
  479.     }
  480.     return z;
  481. }
  482. sqrt.c
  483. #include "math.h"
  484. #include "errno.h"
  485.  
  486. double sqrt(x)
  487. double x;
  488. {
  489.     double f, y;
  490.     int n;
  491.     extern int errno;
  492.     
  493.     if (x == 0.0)
  494.         return x;
  495.     if (x < 0.0) {
  496.         errno = EDOM;
  497.         return 0.0;
  498.     }
  499.     f = frexp(x, &n);
  500.     y = 0.41731 + 0.59016 * f;
  501.     y = (y + f/y);
  502.     y = ldexp(y,-2) + f/y;    /* fast calculation of y2 */
  503.     y = ldexp(y + f/y, -1);
  504.     y = ldexp(y + f/y, -1);
  505.     
  506.     if (n&1) {
  507.         y *= 0.70710678118654752440;
  508.         ++n;
  509.     }
  510.     return ldexp(y,n/2);
  511. }
  512. tan.c
  513. #include "math.h"
  514. #include "errno.h"
  515.  
  516. extern int errno;
  517.  
  518. static double tansub();
  519.  
  520. double cotan(x)
  521. double x;
  522. {
  523.     double y;
  524.     
  525.     y = fabs(x);
  526.     if (y < 1.0/HUGE_VAL) {
  527.         errno = ERANGE;
  528.         if (x < 0.0)
  529.             return -HUGE_VAL;
  530.         else
  531.             return HUGE_VAL;
  532.     }
  533.     return tansub(x,y,2);
  534. }
  535.  
  536. double tan(x)
  537. double x;
  538. {
  539.     return tansub(x, fabs(x), 0);
  540. }
  541.  
  542. #define P1 -0.13338350006421960681e+0
  543. #define P2 +0.34248878235890589960e-2
  544. #define P3 -0.17861707342254426711e-4
  545. #define Q0 +1.0
  546. #define Q1 -0.46671683339755294240e+0
  547. #define Q2 +0.25663832289440112864e-1
  548. #define Q3 -0.31181531907010027307e-3
  549. #define Q4 +0.49819433993786512270e-6
  550.  
  551. #define P(f,g) (((P3*g P2)*g P1)*g*f + f)
  552. #define Q(g) ((((Q4*g Q3)*g Q2)*g Q1)*g Q0)
  553.  
  554. #define YMAX 6.74652e09
  555.  
  556. static double tansub(x, y, flag)
  557. double x,y;
  558. {
  559.     double f, g, xn;
  560.     double xnum, xden;
  561.     
  562.     if (y > YMAX) {
  563.         errno = ERANGE;
  564.         return 0.0;
  565.     }
  566.     if (modf(x*0.63661977236758134308, &xn) >= 0.5)
  567.         xn += (x < 0.0) ? -1.0 : 1.0;
  568.     f = (x - xn*1.57080078125) + xn*4.454455103380768678308e-6;
  569.     if (fabs(f) < 2.33e-10) {
  570.         xnum = f;
  571.         xden = 1.0;
  572.     } else {
  573.         g = f*f;
  574.         xnum = P(f,g);
  575.         xden = Q(g);
  576.     }
  577.     flag |= ((int)xn & 1);
  578.     switch (flag) {
  579.     case 1:        /* A: tan, xn odd */
  580.         xnum = -xnum;
  581.     case 2:        /* B: cotan, xn even */
  582.         return xden/xnum;
  583.         
  584.     case 3:        /* C: cotan, xn odd */
  585.         xnum = -xnum;
  586.     case 0:        /* D: tan, xn even */
  587.         return xnum/xden;
  588.     }
  589.     return 0.0;
  590. }
  591. tanh.c
  592. #include "math.h"
  593.  
  594. #define P0 -0.16134119023996228053e+4
  595. #define P1 -0.99225929672236083313e+2
  596. #define P2 -0.96437492777225469787e+0
  597. #define Q0 +0.48402357071988688686e+4
  598. #define Q1 +0.22337720718962312926e+4
  599. #define Q2 +0.11274474380534949335e+3
  600.  
  601. #define gP(g) (((P2*g P1)*g P0)*g)
  602. #define Q(g) (((g Q2)*g Q1)*g Q0)
  603.  
  604. double tanh(x)
  605. double x;
  606. {
  607.     double f,g,r;
  608.     
  609.     f = fabs(x);
  610.     if (f > 25.3)
  611.         r = 1.0;
  612.     else if (f > 0.54930614433405484570) {
  613.         r = 0.5 - 1.0/(exp(f+f)+1.0);
  614.         r += r;
  615.     } else if (f < 2.3e-10)
  616.         r = f;
  617.     else {
  618.         g = f*f;
  619.         r = f + f*
  620.             (gP(g)
  621.             /Q(g));
  622.     }
  623.     if (x < 0.0)
  624.         r = -r;
  625.     return r;
  626. }
  627. atof.asm
  628. ; Copyright (C) 1983 by Manx Software Systems
  629. ;
  630. ;double
  631. ;atof(cp)
  632. ;register char *cp;
  633.     include lmacros.h
  634.  
  635. IFDEF LONGPTR
  636. cp    equ    es:byte ptr [di]
  637. getes    macro
  638.     mov    es,ss:word ptr acp[2]
  639.     endm
  640.  
  641. ELSE
  642.  
  643. cp    equ    byte ptr [di]
  644. getes    macro
  645. ;
  646.     endm
  647. ENDIF
  648.  
  649.     procdef atof,<<acp,ptr>>
  650.     sub    sp,2
  651.     push    di
  652.     push    si
  653. ;{
  654. ifndef LONGPTR
  655.     mov    di,ds
  656.     mov    es,di
  657. endif
  658.     ldptr di,acp,es
  659. ;    double acc;
  660. ;    int msign, esign, dpflg;
  661. ;    int i, dexp;
  662. msign    equ    byte ptr -1[bp]
  663. esign    equ    byte ptr -2[bp]        ;these two aren't active at the same time
  664. dpflg    equ    byte ptr -2[bp]
  665.  
  666. ;    while (*cp == ' ' || *cp == '\t')
  667. ;        ++cp;
  668. skiploop:
  669.     mov    al,cp
  670.     cmp    al,' '
  671.     je    skipbl
  672.     cmp    al,9
  673.     jne    skipdone
  674. skipbl:
  675.     inc    di
  676.     jmp    skiploop
  677. skipdone:
  678. ;    if (*cp == '-') {
  679.     cmp al,45
  680.     jne $3
  681. ;        ++cp;
  682.     inc di
  683. ;        msign = 1;
  684.     mov msign,1
  685.     jmp short $4
  686. ;    } else {
  687. $3:
  688. ;        msign = 0;
  689.     mov msign,0
  690. ;        if (*cp == '+')
  691. ;            ++cp;
  692.     cmp al,43
  693.     jne $4
  694.     inc di
  695. ;    }
  696. $4:
  697. ;    dpflg = dexp = 0;
  698.     mov si,0
  699.     mov dpflg,0
  700. ;    for (acc = zero ; ; ++cp) {
  701.     call    $dlip
  702.     dw    0,0,0,0
  703. $6:
  704. ;        if (isdigit(*cp)) {
  705.     getes
  706.     mov al,cp
  707.     cmp    al,'0'
  708.     jb    $9
  709.     cmp    al,'9'
  710.     ja    $9
  711. ;            acc *= ten;
  712.     call    $dlis
  713.     dw    0,0,0,4024H
  714.     call $dml
  715. ;            acc += *cp - '0';
  716.     call    $dswap
  717.     getes
  718.     mov al,cp
  719.     cbw
  720.     add ax,-48
  721.     call $itod
  722.     call $dad
  723. ;            if (dpflg)
  724. ;                --dexp;
  725.     cmp dpflg,0
  726.     je $11
  727.     dec    si
  728.     jmp short $11
  729. ;        } else if (*cp == '.') {
  730. $9:
  731.     cmp al,'.'
  732.     jne $8
  733. ;            if (dpflg)
  734. ;                break;
  735.     cmp dpflg,0
  736.     jne $8
  737. ;            dpflg = 1;
  738.     mov dpflg,1
  739. ;        } else
  740. ;            break;
  741. $11:
  742. ;    }
  743.     inc di
  744.     jmp $6
  745. $8:
  746. ;    if (*cp == 'e' || *cp == 'E') {
  747.     cmp al,101
  748.     je $15
  749.     cmp al,69
  750.     jne $14
  751. $15:
  752. ;        ++cp;
  753.     inc di
  754. ;        if (*cp == '-') {
  755.     cmp cp,45
  756.     jne $16
  757. ;            ++cp;
  758.     inc di
  759. ;            esign = 1;
  760.     mov esign,1
  761.     jmp short $17
  762. ;        } else {
  763. $16:
  764. ;            esign = 0;
  765.     mov esign,0
  766. ;            if (*cp == '+')
  767. ;                ++cp;
  768.     cmp cp,43
  769.     jne $17
  770.     inc di
  771. ;        }
  772. $17:
  773. ;        for ( i = 0 ; isdigit(*cp) ; i = i*10 + *cp++ - '0' )
  774.     sub    ax,ax
  775.     mov cx,10
  776.     jmp short $20
  777. $19:
  778.     mul cx
  779.     mov    dx,ax
  780.     mov al,cp
  781.     inc di
  782.     cbw
  783.     add ax,dx
  784.     add ax,-48
  785. $20:
  786.     mov bl,cp
  787.     cmp    bl,'0'
  788.     jb $21
  789.     cmp    bl,'9'
  790.     jbe $19
  791. ;            ;
  792. $21:
  793. ;        if (esign)
  794. ;            i = -i;
  795.     cmp esign,0
  796.     je $22
  797.     neg ax
  798. $22:
  799. ;        dexp += i;
  800.     add si,ax
  801. ;    }
  802. ;    if (dexp < 0) {
  803. $14:
  804.     call    $dlis
  805.     dw    0,0,0,4024H
  806.     test    si,si
  807.     jns $23
  808. ;        while (dexp++)
  809. $24:
  810. ;            acc /= ten;
  811.     call $ddv
  812.     inc    si
  813.     jnz    $24
  814.     jmp short $26
  815. ;    } else if (dexp > 0) {
  816. $23:
  817.     jz $26
  818. ;        while (dexp--)
  819. $28:
  820. ;            acc *= ten;
  821.     call $dml
  822.     dec    si
  823.     jnz $28
  824. ;    }
  825. $26:
  826. ;    if (msign)
  827. ;        acc = -acc;
  828.     cmp msign,0
  829.     je $30
  830.     call $dng
  831. ;    return acc;
  832. $30:
  833.     pop    si
  834.     pop    di
  835.     mov    sp,bp
  836.     pret
  837. ;}
  838.     pend    atof
  839. ifdef FARPROC
  840.     extrn    $dad:far,$dml:far,$ddv:far,$dlip:far,$dlis:far
  841.     extrn    $dng:far,$dswap:far,$itod:far
  842. else
  843.     extrn    $dad:near,$dml:near,$ddv:near,$dlip:near,$dlis:near
  844.     extrn    $dng:near,$dswap:near,$itod:near
  845. endif
  846.     finish
  847.     end
  848. ftoa.asm
  849. ; Copyright (C) 1984 by Manx Software Systems
  850. ;
  851.     include lmacros.h
  852. ;
  853. ;static double round[] = {
  854. dataseg    segment    word public 'data'
  855. round_ equ this word
  856. ;    1.0e+0,
  857.     db 00H,00H,00H,00H,00H,00H,0f0H,03fH
  858. ;    0.5e+0,
  859.     db 00H,00H,00H,00H,00H,00H,0e0H,03fH
  860. ;    0.5e-1,
  861.     db 09aH,099H,099H,099H,099H,099H,0a9H,03fH
  862. ;    0.5e-2,
  863.     db 07bH,014H,0aeH,047H,0e1H,07aH,074H,03fH
  864. ;    0.5e-3,
  865.     db 0fcH,0a9H,0f1H,0d2H,04dH,062H,040H,03fH
  866. ;    0.5e-4,
  867.     db 02dH,043H,01cH,0ebH,0e2H,036H,0aH,03fH
  868. ;    0.5e-5,
  869.     db 0f1H,068H,0e3H,088H,0b5H,0f8H,0d4H,03eH
  870. ;    0.5e-6,
  871.     db 08dH,0edH,0b5H,0a0H,0f7H,0c6H,0a0H,03eH
  872. ;    0.5e-7,
  873.     db 048H,0afH,0bcH,09aH,0f2H,0d7H,06aH,03eH
  874. ;    0.5e-8,
  875.     db 03aH,08cH,030H,0e2H,08eH,079H,035H,03eH
  876. ;    0.5e-9,
  877.     db 095H,0d6H,026H,0e8H,0bH,02eH,01H,03eH
  878. ;    0.5e-10,
  879.     db 0bbH,0bdH,0d7H,0d9H,0dfH,07cH,0cbH,03dH
  880. ;    0.5e-11,
  881.     db 095H,064H,079H,0e1H,07fH,0fdH,095H,03dH
  882. ;    0.5e-12,
  883.     db 011H,0eaH,02dH,081H,099H,097H,061H,03dH
  884. ;    0.5e-13,
  885.     db 082H,076H,049H,068H,0c2H,025H,02cH,03dH
  886. ;    0.5e-14,
  887.     db 09bH,02bH,0a1H,086H,09bH,084H,0f6H,03cH
  888. ;    0.5e-15,
  889.     db 016H,056H,0e7H,09eH,0afH,03H,0c2H,03cH
  890. ;    0.5e-16,
  891. ;    db 0bcH,089H,0d8H,097H,0b2H,0d2H,08cH,03cH
  892. ;    0.5e-17,
  893. ;    db 097H,0d4H,046H,046H,0f5H,0eH,057H,03cH
  894. ;    0.5e-18,
  895. ;    db 0acH,043H,0d2H,0d1H,05dH,072H,022H,03cH
  896. ;};
  897. dataseg    ends
  898.     assume    ds:dataseg
  899. IFDEF LONGPTR
  900. buffer    equ    es:byte ptr [di]
  901. getes    macro
  902.     mov    es,word ptr abuf[2]
  903.     endm
  904. ELSE
  905.  
  906. buffer    equ    byte ptr [di]
  907. getes    macro
  908. ;
  909.     endm
  910. ENDIF
  911. ;
  912. ;ftoa(number, abuf, maxwidth, flag)
  913. ;double number; register char *abuf;
  914.     procdef ftoa, <<number,cdouble>,<abuf,ptr>,<maxwidth,word>,<flag,word>>
  915.     add sp,-8
  916.     push di
  917.     push si
  918.     mov di,word ptr abuf    ;load offset word of buffer
  919. ;{
  920. ;    register int i;
  921. ;    int exp, digit, decpos, ndig;
  922. ;
  923. ;    ndig = maxwidth+1;
  924.     mov ax,maxwidth
  925.     inc ax
  926.     mov word ptr -8[bp],ax
  927. ;    exp = 0;
  928.     mov word ptr -2[bp],0
  929. ;    if (number < 0.0) {
  930. ifdef LONGPTR
  931.     mov    bx,ss
  932.     mov    es,bx
  933. endif
  934.     lea bx,number
  935.     call $dldp
  936.     call $dlis
  937.     db 00H,00H,00H,00H,00H,00H,00H,00H
  938.     call $dcmp
  939.     je $4            ;skip scaling if zero
  940.     jge $3
  941. ;        number = -number;
  942.     call $dng
  943. ;        *buffer++ = '-';
  944.     getes
  945.     mov buffer,'-'
  946.     inc    di
  947. ;    }
  948. $3:
  949.     call $isnan
  950.     je    notnan
  951.     mov    cx,ax
  952.     mov    al,'?'
  953.     cmp    cx,1
  954.     beq    outrange
  955.     mov    al,'*'
  956.     jmp    outrange
  957. notnan:
  958. ;    if (number > 0.0) {
  959. ;        while (number < 1.0) {
  960. $5:
  961.     call $dlis
  962.     db 00H,00H,00H,00H,00H,00H,0f0H,03fH
  963.     call $dcmp
  964.     jge $6
  965. ;            number *= 10.0;
  966.     call $dlis
  967.     db 00H,00H,00H,00H,00H,00H,024H,040H
  968.     call $dml
  969. ;            --exp;
  970.     dec    word ptr -2[bp]
  971. ;        }
  972.     jmp $5
  973. $6:
  974. ;        while (number >= 10.0) {
  975.     call $dlis
  976.     db 00H,00H,00H,00H,00H,00H,024H,040H
  977. $7:
  978.     call $dcmp
  979.     jl $8
  980. ;            number /= 10.0;
  981.     call $ddv
  982. ;            ++exp;
  983.     inc word ptr -2[bp]
  984. ;        }
  985.     jmp $7
  986. $8:
  987. ;    }
  988. ;
  989. ;    if (flag == 2) {        /* 'g' format */
  990. $4:
  991.     mov ax,flag
  992.     cmp ax,2
  993.     jne $9
  994. ;        ndig = maxwidth;
  995.     mov ax,maxwidth
  996.     mov word ptr -8[bp],ax
  997. ;        if (exp < -4 || exp > maxwidth)
  998. ;            flag = 0;        /* switch to 'e' format */
  999.     mov ax,word ptr -2[bp]
  1000.     cmp ax,-4
  1001.     jl $11
  1002.     cmp ax,maxwidth
  1003.     jle $10
  1004. $11:
  1005.     mov flag,0
  1006. $10:
  1007.     jmp $12
  1008. ;    } else if (flag == 1)    /* 'f' format */
  1009. ;        ndig += exp;
  1010. $9:
  1011.     cmp al,1
  1012.     jne $13
  1013.     mov ax,word ptr -2[bp]
  1014.     add word ptr -8[bp],ax
  1015. ;
  1016. ;    if (ndig >= 0) {
  1017. $13:
  1018. $12:
  1019.     mov bx,word ptr -8[bp]
  1020.     test    bx,bx
  1021.     jl $14
  1022. ;        if ((number += round[ndig>16?16:ndig]) >= 10.0) {
  1023.     cmp bx,16
  1024.     jle $16
  1025.     mov bx,16
  1026. $16:
  1027.     mov cx,3
  1028.     shl bx,cl
  1029.     add bx,offset round_
  1030. ifdef LONGPTR
  1031.     mov    dx,ds
  1032.     mov    es,dx
  1033. endif
  1034.     call $dlds
  1035.     call $dad
  1036.     call $dlis
  1037.     db 00H,00H,00H,00H,00H,00H,024H,040H
  1038.     call $dcmp
  1039.     jl $15
  1040. ;            number = 1.0;
  1041.     call $dlip
  1042.     db 00H,00H,00H,00H,00H,00H,0f0H,03fH
  1043. ;            ++exp;
  1044.     inc word ptr -2[bp]
  1045. ;            if (flag)
  1046. ;                ++ndig;
  1047.     cmp flag,0
  1048.     je $18
  1049.     inc word ptr -8[bp]
  1050. ;        }
  1051. $18:
  1052. ;    }
  1053. $15:
  1054. ;
  1055. ;    if (flag) {
  1056. $14:
  1057.     cmp flag,0
  1058.     je $19
  1059. ;        if (exp < 0) {
  1060.     mov ax,word ptr -2[bp]
  1061.     test ax,ax
  1062.     jge $20
  1063. ;            *buffer++ = '0';
  1064.     getes
  1065.     mov buffer,'0'
  1066.     inc    di
  1067. ;            *buffer++ = '.';
  1068.     mov buffer,'.'
  1069.     inc    di
  1070. ;            i = -exp - 1;
  1071.     not ax
  1072.     mov cx,ax
  1073. ;            if (ndig <= 0)
  1074. ;                i = maxwidth;
  1075.     cmp word ptr -8[bp],0
  1076.     jg $21
  1077.     mov cx,maxwidth
  1078. $21:
  1079. ;            while (i--)
  1080. ;                *buffer++ = '0';
  1081.     jcxz    $23
  1082.     mov    al,'0'
  1083. rep    stosb
  1084. $23:
  1085. ;            decpos = 0;
  1086.     sub    ax,ax
  1087. ;        } else {
  1088.     jmp short $25
  1089. $20:
  1090. ;            decpos = exp+1;
  1091. ;        }
  1092.     mov ax,word ptr -2[bp]
  1093.     inc ax
  1094.     jmp short $25
  1095. ;    } else {
  1096. $19:
  1097. ;        decpos = 1;
  1098.     mov ax,1
  1099. ;    }
  1100. $25:
  1101.     mov word ptr -6[bp],ax
  1102. ;
  1103. ;    if (ndig > 0) {
  1104.     cmp    word ptr -8[bp],0
  1105.     jle    $28
  1106. ;        for (i = 0 ; ; ++i) {
  1107.     mov si,0
  1108.     jmp short $27
  1109. $26:
  1110.     inc si
  1111. $27:
  1112. ;            if (i < 16) {
  1113.     cmp si,16
  1114.     jge $29
  1115. ;                digit = (int)number;
  1116.     call $dtoi
  1117.     push    ax
  1118. ;                *buffer++ = digit+'0';
  1119.     getes
  1120.     add al,'0'
  1121.     stosb
  1122. ;                number = (number - digit) * 10.0;
  1123.     call    $dswap        ;preserve number
  1124.     pop    ax
  1125.     call $utod
  1126.     call    $dswap        ;number back into primary, digit into secondary
  1127.     call $dsb
  1128.     call $dlis
  1129.     db 00H,00H,00H,00H,00H,00H,024H,040H
  1130.     call $dml
  1131.     jmp short $30
  1132. ;            } else
  1133. $29:
  1134. ;                *buffer++ = '0';
  1135.     getes
  1136.     mov    buffer,'0'
  1137.     inc di
  1138. $30:
  1139. ;            if (--ndig == 0)
  1140. ;                break;
  1141.     dec word ptr -8[bp]
  1142.     jz $28
  1143. ;            if (decpos && --decpos == 0)
  1144. ;                *buffer++ = '.';
  1145.     mov    ax,word ptr -6[bp]
  1146.     test    ax,ax
  1147.     jz $26
  1148.     dec    ax
  1149.     mov word ptr -6[bp],ax
  1150.     jnz $26
  1151.     getes
  1152.     mov    buffer,'.'
  1153.     inc di
  1154. ;        }
  1155.     jmp $26
  1156. ;    }
  1157. $28:
  1158.     getes
  1159. ;
  1160. ;    if (!flag) {
  1161.     cmp flag,0
  1162.     jne $32
  1163. ;        *buffer++ = 'e';
  1164.     mov    buffer,'e'
  1165.     inc di
  1166. ;        if (exp < 0) {
  1167. ;            exp = -exp;
  1168. ;            *buffer++ = '-';
  1169.     mov    al,'+'
  1170.     cmp word ptr -2[bp],0
  1171.     jge $33
  1172.     neg word ptr -2[bp]
  1173.     mov    al,'-'
  1174. ;        } else
  1175. ;            *buffer++ = '+';
  1176. $33:
  1177.     stosb
  1178. ;        if (exp >= 100) {
  1179.     mov ax,word ptr -2[bp]
  1180.     cmp ax,100
  1181.     jl $35
  1182. ;            *buffer++ = exp/100 + '0';
  1183.     mov cx,100
  1184.     cwd
  1185.     idiv cx
  1186.     add al,'0'
  1187.     stosb
  1188. ;            exp %= 100;
  1189.     mov ax,dx
  1190. ;        }
  1191. ;        *buffer++ = exp/10 + '0';
  1192. $35:
  1193.     mov cx,10
  1194.     cwd
  1195.     idiv cx
  1196.     add al,'0'
  1197.     stosb
  1198. ;        *buffer++ = exp%10 + '0';
  1199.     mov ax,dx
  1200.     add al,'0'
  1201.     stosb
  1202. ;    }
  1203. ;    *buffer = 0;
  1204. $32:
  1205.     mov buffer,0
  1206. ;}
  1207.     pop    si
  1208.     pop    di
  1209.     mov    sp,bp
  1210.     pret
  1211.  
  1212. outrange:
  1213.     mov cx,maxwidth
  1214.     jcxz    $32
  1215. rep    stosb
  1216.     jmp    $32
  1217. ;
  1218. ifdef FARPROC
  1219.     extrn $dad:far,$dsb:far,$dml:far,$ddv:far
  1220.     extrn $dldp:far,$dlds:far,$dlip:far,$dlis:far
  1221.     extrn $dcmp:far,$dng:far,$dswap:far,$utod:far,$dtoi:far
  1222.     extrn $isnan:far
  1223. else
  1224.     extrn $dad:near,$dsb:near,$dml:near,$ddv:near
  1225.     extrn $dldp:near,$dlds:near,$dlip:near,$dlis:near
  1226.     extrn $dcmp:near,$dng:near,$dswap:near,$utod:near,$dtoi:near
  1227.     extrn $isnan:near
  1228. endif
  1229.     pend    ftoa
  1230.     finish
  1231.     end
  1232. frexp.asm
  1233. ;    Copyright (C) 1983 by Manx Software Systems
  1234. ; :ts=8
  1235. ;    the psuedo accumlators are formated as follows:
  1236. ;    -10    -8    -6    -4    -2    0
  1237. ;    |grd + LS ----- fraction ---- MS |  exp | sign
  1238. ;
  1239. ;    floating point system error codes:
  1240. UNDER_FLOW    equ    1
  1241. OVER_FLOW    equ    2
  1242. DIV_BY_ZERO    equ    3
  1243. ;
  1244.     include    lmacros.h
  1245. dataseg    segment word public 'data'
  1246.     dw    5 dup (?)
  1247. temp    dw    ?
  1248.     extrn    flprm:word,flsec:word
  1249.     extrn    flterr_:word
  1250. dataseg    ends
  1251.     assume    ds:dataseg
  1252.  
  1253. ifdef FARPROC
  1254.     extrn    $dldp:far, $dst:far, $itod:far
  1255.     extrn    $dad:far, $dsb:far, $isnan:far
  1256. else
  1257.     extrn    $dldp:near, $dst:near, $itod:near
  1258.     extrn    $dad:near, $dsb:near, $isnan:near
  1259. endif
  1260.     procdef isnan
  1261.     sub    ax,ax
  1262.     pret
  1263.     pend    isnan
  1264.  
  1265.     procdef    frexp, <<d,cdouble>,<i,ptr>>
  1266. ;
  1267. ;        frexp(d, &i)
  1268. ;            returns 0 <= x < 1
  1269. ;            such that: d = x * 2^i
  1270. ifdef LONGPTR
  1271.     mov    bx,ss
  1272.     mov    es,bx
  1273. endif
  1274.     lea    bx,d        ;compute address of first argument
  1275.     call    $dldp        ;load it into the float primary
  1276.     mov    bx,flprm
  1277.     mov    ax,word ptr -2[bx]    ;fetch current exponent value
  1278.     test    ax,ax
  1279.     jnz    fr_nzero
  1280.     ldptr    bx,i,es        ;get pointer
  1281. ifndef LONGPTR
  1282.     mov    ds:word ptr [bx],0
  1283. else
  1284.     mov    es:word ptr [bx],0
  1285. endif
  1286.     pret
  1287. fr_nzero:
  1288.     sub    ax,1022
  1289.     mov    word ptr -2[bx],1022
  1290.     ldptr    bx,i,es        ;get pointer
  1291. ifndef LONGPTR
  1292.     mov    ds:word ptr [bx],ax
  1293. else
  1294.     mov    es:word ptr [bx],ax
  1295. endif
  1296.     pret
  1297.     pend    frexp
  1298. ;
  1299. ;    ldexp(d, i)
  1300. ;        returns x = d * 2^i
  1301.     procdef    ldexp, <<dou,cdouble>,<ii,word>>
  1302. ifdef LONGPTR
  1303.     mov    bx,ss
  1304.     mov    es,bx
  1305. endif
  1306.     lea    bx,dou        ;compute address of first argument
  1307.     call    $dldp        ;load it into the float primary
  1308.     mov    bx,flprm
  1309.     mov    ax,word ptr -2[bx]    ;fetch current exponent value
  1310.     test    ax,ax
  1311.     jz    ld_zero
  1312.     add    ax,ii            ;add i to exponent
  1313.     js    ld_underflow
  1314.     cmp    ax,2048
  1315.     jl    ld_ret
  1316.     mov    flterr_,UNDER_FLOW
  1317.     mov    ax,2047
  1318. ld_ret:
  1319.     mov    word ptr -2[bx],ax
  1320. ld_zero:
  1321.     pret
  1322. ;
  1323. ld_underflow:
  1324.     mov    flterr_,UNDER_FLOW
  1325.     sub    ax,ax
  1326.     jmp    ld_ret
  1327.     pend    ldexp
  1328. ;
  1329. ;    modf(d, dptr)
  1330. ;        returns fractional part of d, and
  1331. ;        stores integral part into *dptr
  1332.     procdef    modf,<<doubl,cdouble>,<dptr,ptr>>
  1333.     push    di
  1334.     push    si
  1335.     pushds
  1336. ifdef LONGPTR
  1337.     mov    bx,ss
  1338.     mov    es,bx
  1339. endif
  1340.     lea    bx,doubl    ;compute address of first argument
  1341.     call    $dldp        ;load it into the float primary
  1342.     std
  1343.     mov    bx,flprm
  1344.     mov    ax,word ptr -2[bx]    ;fetch current exponent value
  1345.     test    ax,ax
  1346.     jnz    mf_nzero
  1347.     ldptr    bx,dptr,es    ;get pointer
  1348.     call    $dst
  1349. mf_return:
  1350.     cld
  1351.     popds
  1352.     pop    si
  1353.     pop    di
  1354.     pret
  1355. mf_nzero:
  1356.     mov    di,ds
  1357.     mov    es,di
  1358.     mov    si,bx
  1359.     mov    di,offset temp
  1360.     mov    cx,6        ;save value for fraction part later
  1361. rep    movsw
  1362.     sub    ax,1023
  1363.     jns    int_notzero
  1364.     mov    ax,0
  1365.     call    $itod
  1366.     jmp    get_fraction
  1367. int_notzero:
  1368.     cmp    ax,52
  1369.     jna    mf_frac
  1370.                 ;fraction is zero
  1371.     ldptr    bx,dptr,es    ;get pointer
  1372.     call    $dst        ;store integer part away
  1373.     sub    ax,ax
  1374.     call    $itod
  1375.     jmp    mf_return
  1376. mf_frac:
  1377.     sub    di,di
  1378.     mov    cx,ax
  1379.     mov    ax,4
  1380. mf_count:
  1381.     sub    cx,ax
  1382.     jbe    mf_cdone
  1383.     dec    di
  1384.     mov    ax,8
  1385.     jmp    mf_count
  1386. mf_cdone:
  1387.     jcxz    no_shift
  1388.     neg    cx
  1389.     mov    al,byte ptr -3[bx][di]
  1390.     shr    al,cl
  1391.     shl    al,cl
  1392.     mov    byte ptr -3[bx][di],al
  1393. no_shift:
  1394.     dec    di
  1395. zap_loop:
  1396.     cmp    di,-8
  1397.     jle    get_fraction
  1398.     mov    byte ptr -3[bx][di],0
  1399.     dec    di
  1400.     jmp    zap_loop
  1401. get_fraction:
  1402.     ldptr    bx,dptr,es    ;get pointer
  1403.     call    $dst        ;store integer part away
  1404.     std
  1405.     popds
  1406.     pushds
  1407.     mov    di,flprm
  1408.     xchg    di,flsec
  1409.     mov    flprm,di
  1410.     mov    si,ds
  1411.     mov    es,si
  1412.     mov    si,offset temp
  1413.     mov    cx,6        ;restore original value
  1414. rep    movsw
  1415.     call    $dsb        ;compute fractional part
  1416.     jmp    mf_return
  1417.     pend    modf
  1418.     finish
  1419.     end
  1420. fsubs.asm
  1421. ifndef INTERNAL
  1422. ;    Copyright (C) 1983 by Manx Software Systems
  1423. ; :ts=8
  1424. ;    the psuedo accumlators are formated as follows:
  1425. ;    -10    -8    -6    -4    -2    0
  1426. ;    |grd + LS ----- fraction ---- MS |  exp | sign
  1427. ;
  1428. ;    floating point system error codes:
  1429.     include lmacros.h
  1430. UNDER_FLOW    equ    1
  1431. OVER_FLOW    equ    2
  1432. DIV_BY_ZERO    equ    3
  1433. ;
  1434. dataseg    segment word public 'data'
  1435.     public    flprm,flsec
  1436.     public    flterr_
  1437. flterr_    dw    0
  1438. flprm    dw    acc1
  1439. flsec    dw    acc2
  1440. YU    dw    ?
  1441. VEE    dw    ?
  1442.     dw    4 dup (?)
  1443. acc1    dw    6 dup (?)
  1444. acc2    dw    ?
  1445. ;
  1446. ;work area for divide and multiply routines
  1447. ;
  1448.     dw    ?
  1449. temp    dw    4 dup (?)
  1450. loop_count    db    0    ;iterations left (for divide)
  1451. lcnt1    db    0        ;# iter. for this word of quotient
  1452. dataseg    ends
  1453. ifdef LONGPTR
  1454.     assume    ds:dataseg
  1455. else
  1456.     assume    ds:dataseg,es:dataseg,ss:dataseg
  1457. endif
  1458.  
  1459.  
  1460.     internal $floats
  1461. endif
  1462.     intrdef $isnan
  1463.     sub    ax,ax
  1464.     ret
  1465.  
  1466.     intrdef $flds        ;load single float into secondary accum
  1467.     push    di
  1468.     mov    di,flsec
  1469.     jmp    short fload
  1470.  
  1471. ifdef LONGPTR
  1472.     intrdef $fldsss    ;load single float into secondary accum
  1473.     push    di
  1474.     mov    di,ss
  1475.     mov    es,di
  1476.     mov    di,flsec
  1477.     jmp    short fload
  1478.  
  1479.     intrdef $fldsds    ;load single float into secondary accum
  1480.     push    di
  1481.     mov    di,ds
  1482.     mov    es,di
  1483.     mov    di,flsec
  1484.     jmp    short fload
  1485.  
  1486.     intrdef $fldpss    ;load single float into secondary accum
  1487.     push    di
  1488.     mov    di,ss
  1489.     mov    es,di
  1490.     mov    di,flprm
  1491.     jmp    short fload
  1492.  
  1493.     intrdef $fldpds    ;load single float into secondary accum
  1494.     push    di
  1495.     mov    di,ds
  1496.     mov    es,di
  1497.     mov    di,flprm
  1498.     jmp    short fload
  1499.  
  1500. endif
  1501. ;
  1502.     intrdef $fldp        ;load single float into primary accum
  1503.     push    di
  1504.     mov    di,flprm
  1505. fload:
  1506.     push    si
  1507. ifndef LONGPTR
  1508.     mov    si,ds
  1509.     mov    es,si
  1510. endif
  1511.     mov    ax,es:2[bx]    ;get exponent/sign word of number
  1512.     mov    byte ptr [di],ah ;save sign
  1513.     mov    dh,al        ;save fraction bits
  1514.     shl    ax,1        ;get LS bit of exponent
  1515.     xchg    ah,al
  1516.     and    ax,0ffH
  1517.     jnz    fld_nz
  1518.     pushds
  1519. ifdef LONGPTR
  1520.     mov    ax,ds
  1521.     mov    es,ax
  1522. endif
  1523.     jmp    loadzero
  1524. fld_nz:
  1525.     sub    ax,127        ;adjust from excess 127 notation
  1526.     add    ax,1023        ;put into excess 1023 notation
  1527.     mov    word ptr -2[di],ax ;and save
  1528.     or    dh,80H        ;turn "hidden" bit back on
  1529.     mov    dl,es:byte ptr 1[bx]
  1530.     mov    ah,es:byte ptr [bx]
  1531.     sub    al,al
  1532.     shr    dx,1        ;shift fraction into same position as a double
  1533.     rcr    ax,1
  1534.     shr    dx,1
  1535.     rcr    ax,1
  1536.     shr    dx,1
  1537.     rcr    ax,1
  1538.     mov    word ptr -4[di],dx
  1539.     mov    word ptr -6[di],ax
  1540.     sub    ax,ax
  1541.     mov    word ptr -8[di],ax
  1542.     mov    word ptr -10[di],ax
  1543.     pop    si
  1544.     pop    di
  1545.     ret
  1546. ;
  1547.  
  1548. ifdef LONGPTR
  1549.     intrdef $fstss
  1550.     mov    cx,ss
  1551.     mov    es,cx
  1552.     jmp    short dofst
  1553.  
  1554.     intrdef $fstds
  1555.     mov    cx,ds
  1556.     mov    es,cx
  1557.     jmp    short dofst
  1558.  
  1559.     intrdef $fstsss
  1560.     mov    cx,ss
  1561.     mov    es,cx
  1562.     jmp    short dofsts
  1563.  
  1564.     intrdef $fstsds
  1565.     mov    cx,ds
  1566.     mov    es,cx
  1567.     jmp    short dofsts
  1568. endif
  1569.  
  1570.     intrdef $fsts        ; store single from secondary 
  1571. ifndef LONGPTR
  1572.     mov    ax,ds
  1573.     mov    es,ax
  1574. endif
  1575. dofsts:
  1576.     mov    ax,flprm
  1577.     xchg    ax,flsec
  1578.     mov    flprm,ax
  1579. ifdef FARPROC
  1580.     call    far ptr $fst
  1581. else
  1582.     call    $fst
  1583. endif
  1584.     mov    ax,flprm
  1585.     xchg    ax,flsec
  1586.     mov    flprm,ax
  1587.     ret
  1588.  
  1589.     intrdef  $fst        ;store single at addr in BX
  1590. dofst:
  1591.     push    di
  1592.     push    si
  1593.     push    bx
  1594.     call    dornd
  1595.     pop    di
  1596.     mov    si,flprm
  1597.     mov    ax,-2[si]    ;get exponent
  1598.     test    ax,ax
  1599.     jnz    fst_nzero
  1600.     mov    es:word ptr [di],0
  1601.     mov    es:word ptr 2[di],0
  1602.     pop    si
  1603.     pop    di
  1604.     ret
  1605. fst_nzero:
  1606.     sub    ax,1023        ;switch from excess 1023 notation
  1607.     add    ax,127        ;into excess 127 notation
  1608.     mov    dx,-4[si]
  1609.     mov    bx,-6[si]
  1610.     add    bx,10H        ;round number
  1611.     adc    dx,0
  1612.     shl    bx,1        ;move number back into proper position
  1613.     rcl    dx,1
  1614.     shl    bx,1
  1615.     rcl    dx,1
  1616.     test    dx,dx
  1617.     js    fix_exp
  1618.     shl    bx,1
  1619.     rcl    dx,1
  1620.     jmp    short fst_merge
  1621. fix_exp:
  1622.     inc    ax        ;adjust exponent
  1623. fst_merge:
  1624.     mov    cl,7
  1625.     shl    ax,cl
  1626.     mov    cl,[si]        ;get sign
  1627.     and    cl,80H
  1628.     or    ah,cl        ;merge sign and exponent
  1629.     and    dh,7fH        ;clear "hidden" bit
  1630.     or    al,dh        ;merge with sign/exponent
  1631.     mov    es:word ptr 2[di],ax
  1632.     mov    es:byte ptr 1[di],dl
  1633.     mov    es:byte ptr [di],bh
  1634.     pop    si
  1635.     pop    di
  1636.     ret
  1637. ;
  1638.     intrdef $dlis        ;load double immediate secondary
  1639. ifdef LONGPTR
  1640.         push    bp
  1641.         mov    bp,sp
  1642.     ifdef FARPROC
  1643.         les    bx,2[bp]
  1644.     else
  1645.         mov    bx,cs
  1646.         mov    es,bx
  1647.         mov    bx,2[bp]
  1648.     endif
  1649.         add    2[bp],8        ;skip over double constant in code
  1650.         pop    bp
  1651.         jmp    dolds
  1652.  
  1653. else
  1654.         mov    bx,sp
  1655.         push    di
  1656.         push    si
  1657.         push    ds
  1658.     ifdef FARPROC
  1659.         lds    si,[bx]        ;get return addr
  1660.     else
  1661.         mov    si,[bx]        ;get return addr
  1662.         mov    di,ds
  1663.         mov    es,di
  1664.         mov    di,cs
  1665.         mov    ds,di
  1666.     endif
  1667.         mov    di,offset temp
  1668.         mov    cx,4
  1669.     rep    movsw
  1670.         pop    ds
  1671.         mov    [bx],si        ;put back correct return addr
  1672.         lea    si,-2[di]
  1673.         mov    di,flsec
  1674.         jmp    dload2
  1675. endif
  1676. ;
  1677. ifdef LONGPTR
  1678.     intrdef $dldsds
  1679.     mov    cx,ds
  1680.     mov    es,cx
  1681.     jmp    dolds
  1682.  
  1683.     intrdef $dldsss
  1684.     mov    cx,ss
  1685.     mov    es,cx
  1686.     jmp    dolds
  1687. endif
  1688.  
  1689.     intrdef $dlds        ;load double float into secondary accum
  1690. ifndef LONGPTR
  1691.     mov    ax,ds
  1692.     mov    es,ax
  1693. endif
  1694. dolds:
  1695.     push    di
  1696.     mov    di,flsec
  1697.     jmp    short dload
  1698. ;
  1699.     intrdef $dlip        ;load double immediate primary
  1700. ifdef LONGPTR
  1701.         push    bp
  1702.         mov    bp,sp
  1703.     ifdef FARPROC
  1704.         les    bx,2[bp]
  1705.     else
  1706.         mov    bx,cs
  1707.         mov    es,bx
  1708.         mov    bx,2[bp]
  1709.     endif
  1710.         add    2[bp],8        ;skip over double constant in code
  1711.         pop    bp
  1712.         jmp    short dodldp
  1713.  
  1714. else
  1715.         mov    bx,sp
  1716.         push    di
  1717.         push    si
  1718.         push    ds
  1719.     ifdef FARPROC
  1720.         lds    si,[bx]        ;get return addr
  1721.     else
  1722.         mov    si,[bx]        ;get return addr
  1723.         mov    di,ds
  1724.         mov    es,di
  1725.         mov    di,cs
  1726.         mov    ds,di
  1727.     endif
  1728.         mov    di,offset temp
  1729.         mov    cx,4
  1730.     rep    movsw
  1731.         pop    ds
  1732.         mov    [bx],si        ;put back correct return addr
  1733.         lea    si,-2[di]
  1734.         mov    di,flprm
  1735.         jmp    dload2
  1736. endif
  1737. ;
  1738. ifdef LONGPTR
  1739.     intrdef $dldpss
  1740.     mov    cx,ss
  1741.     mov    es,cx
  1742.     jmp    short dodldp
  1743.  
  1744.     intrdef $dldpds
  1745.     mov    cx,ds
  1746.     mov    es,cx
  1747.     jmp    short dodldp
  1748. endif
  1749.  
  1750.     intrdef $dldp        ;load double float into primary accum
  1751. ifndef LONGPTR
  1752.     mov    ax,ds
  1753.     mov    es,ax
  1754. endif
  1755. dodldp:
  1756.     push    di
  1757.     mov    di,flprm
  1758. dload:
  1759.     push    si
  1760.     lea    si,6[bx]
  1761. dload2:
  1762. ifdef LONGPTR
  1763.     push    ds
  1764.     mov    cx,es    ;swap the segment registers
  1765.     mov    dx,ds
  1766.     mov    es,dx
  1767.     mov    ds,cx
  1768. endif
  1769.     std
  1770.     lods    word ptr [si];get first two bytes of number
  1771.     mov    es:byte ptr [di],ah ;save sign
  1772.     mov    dh,al        ;save top nibble of fraction
  1773.     mov    cl,4
  1774.     shr    ax,cl
  1775.     and    ax,7ffH        ;isolate exponent
  1776.     jz    loadzero
  1777.     sub    di,2
  1778.     stos    word ptr [di]
  1779.     and    dh,15        ;isolate fraction
  1780.     or    dh,10H        ;put back "hidden" bit
  1781.     mov    es:byte ptr 1[di],dh
  1782.     mov    cx,6
  1783.     inc    si
  1784. rep    movs    byte ptr [di], byte ptr [si]
  1785.     mov    es:byte ptr [di],0    ;clear guard byte
  1786.     cld
  1787.     popds
  1788.     pop    si
  1789.     pop    di
  1790.     ret
  1791. loadzero:
  1792.     std
  1793.     sub    ax,ax
  1794.     mov    cx,6
  1795. rep    stos    word ptr [di]
  1796.     cld
  1797.     popds
  1798.     pop    si
  1799.     pop    di
  1800.     ret
  1801. ;
  1802. ifdef LONGPTR
  1803.     intrdef $dstss
  1804.     mov    cx,ss
  1805.     mov    es,cx
  1806.     jmp    short dodst
  1807.  
  1808.     intrdef $dstds
  1809.     mov    cx,ds
  1810.     mov    es,cx
  1811.     jmp    short dodst
  1812.  
  1813.     intrdef $dstsss
  1814.     mov    cx,ss
  1815.     mov    es,cx
  1816.     jmp    short dodsts
  1817.  
  1818.     intrdef $dstsds
  1819.     mov    cx,ds
  1820.     mov    es,cx
  1821.     jmp    short dodsts
  1822. endif
  1823.     intrdef $dsts
  1824. dodsts:
  1825.     mov    ax,flprm
  1826.     xchg    ax,flsec
  1827.     mov    flprm,ax
  1828. ifdef FARPROC
  1829.     call    far ptr $dst
  1830. else
  1831.     call    $dst
  1832. endif
  1833.     mov    ax,flprm
  1834.     xchg    ax,flsec
  1835.     mov    flprm,ax
  1836.     ret
  1837.  
  1838.  
  1839.     intrdef $dst        ;store double at addr in ES:BX
  1840. dodst:
  1841.     std
  1842. ifndef LONGPTR
  1843.     mov    dx,ds
  1844.     mov    es,dx
  1845. endif
  1846.     push    di
  1847.     push    si
  1848.     push    bx        ;save address
  1849.     call    dornd        ;round fraction to 7 bytes
  1850.     pop    di        ;restore address
  1851.     add    di,6
  1852.     mov    si,flprm
  1853.     mov    dl,[si]    ;get sign
  1854.     and    dl,80H
  1855.     sub    si,2
  1856.     lods    word ptr [si];get exponent
  1857.     mov    cl,4
  1858.     shl    ax,cl
  1859.     or    ah,dl        ;merge sign and exponent
  1860.     mov    dl,1[si]
  1861.     and    dl,15        ;clear "hidden" bit
  1862.     or    al,dl        ;merge with sign/exponent
  1863.     stos    word ptr [di]
  1864.     mov    cx,6
  1865.     inc    di
  1866. rep    movs    byte ptr [di], byte ptr [si]
  1867.     cld
  1868.     pop    si
  1869.     pop    di
  1870.     ret
  1871. ;
  1872.     intrdef $dpshs        ;push double float onto the stack
  1873.                 ;from the primary accumulator
  1874.     pop    ax        ;fetch return address
  1875. ifdef FARPROC
  1876.     pop    dx
  1877. endif
  1878.     sub    sp,8        ;make room for double on stack
  1879. ifdef LONGPTR
  1880.     mov    bx,ss
  1881.     mov    es,bx
  1882. endif
  1883.     mov    bx,sp        ;address of place to store
  1884. ifdef FARPROC
  1885.     push    dx
  1886. endif
  1887.     push    ax        ;put return address back
  1888.     jmp    near ptr dodsts
  1889. ;
  1890.     intrdef $dpsh        ;push double float onto the stack
  1891.                 ;from the primary accumulator
  1892.     pop    ax        ;fetch return address
  1893. ifdef FARPROC
  1894.     pop    dx
  1895. endif
  1896.     sub    sp,8        ;make room for double on stack
  1897. ifdef LONGPTR
  1898.     mov    bx,ss
  1899.     mov    es,bx
  1900. endif
  1901.     mov    bx,sp        ;address of place to store
  1902. ifdef FARPROC
  1903.     push    dx
  1904. endif
  1905.     push    ax        ;put return address back
  1906.     jmp    near ptr dodst
  1907. ;
  1908.     intrdef $dpopp        ;pop double float into secondary accum
  1909. ifdef LONGPTR
  1910.     mov    bx,ss
  1911.     mov    es,bx
  1912. endif
  1913.     mov    bx,sp
  1914.     add    bx,FPTRSIZE    ;address of data to load
  1915. ifdef FARPROC
  1916.     call    far ptr $dldp
  1917. else
  1918.     call    $dldp
  1919. endif
  1920.     ret    8        ;return and de-allocate space
  1921. ;
  1922.     intrdef $dpop        ;pop double float into secondary accum
  1923. ifdef LONGPTR
  1924.     mov    bx,ss
  1925.     mov    es,bx
  1926. endif
  1927.     mov    bx,sp
  1928.     add    bx,FPTRSIZE    ;address of data to load
  1929. ifdef FARPROC
  1930.     call    far ptr $dlds
  1931. else
  1932.     call    $dlds
  1933. endif
  1934.     ret    8        ;return and de-allocate space
  1935. ;
  1936.     intrdef $dswap        ;exchange primary and secondary
  1937.     mov    ax,flsec
  1938.     xchg    ax,flprm
  1939.     mov    flsec,ax
  1940.     ret
  1941. ;
  1942.     intrdef $dng        ;negate primary
  1943.     mov    bx,flprm
  1944.     xor    byte ptr [bx],80H        ;flip sign
  1945.     ret
  1946. ;
  1947.     intrdef $dtst        ;test if primary is zero
  1948.     mov    bx,flprm
  1949.     cmp    word ptr -2[bx],0
  1950.     jne    true
  1951.     sub    ax,ax
  1952.     ret
  1953. true:
  1954.     sub    ax,ax
  1955.     inc    ax
  1956.     ret
  1957. ;
  1958.     intrdef $dcmp        ;compare primary and secondary
  1959.     push    di
  1960.     push    si
  1961.     std
  1962.     mov    si,flprm
  1963.     mov    di,ds
  1964.     mov    es,di
  1965.     mov    di,flsec
  1966.     mov    al,byte ptr [si]
  1967.     test    al,al        ;is primary negative
  1968.     js    dcneg
  1969. ;            primary is positive
  1970.     xor    al,byte ptr [di]    ;check if signs the same
  1971.     js    p_gt_s            ;differ then p > s
  1972.     jmp    short docomp
  1973. dcneg:
  1974.             ;primary is negative
  1975.     xor    al,byte ptr [di]    ;check if signs the same
  1976.     js    p_lt_s            ;differ the p < s
  1977.     xchg    di,si            ;both negative reverse sense of test
  1978. docomp:
  1979.     sub    di,2        ;back up to exponent
  1980.     sub    si,2
  1981.     mov    cx,5        ;test exponent + 4 words of fraction
  1982. repe    cmps    acc1, es:acc2
  1983.     jb    p_lt_s
  1984.     ja    p_gt_s
  1985.             ;return 0 if p == s
  1986.     xor    ax,ax
  1987.     jmp    short cmp_return
  1988.             ;return 0 if p == s
  1989. p_lt_s:            ;return < 0 if p < s
  1990.     xor    ax,ax
  1991.     dec    ax
  1992.     jmp    short cmp_return
  1993. ;
  1994. p_gt_s:            ;    > 0 if p > s
  1995.     xor    ax,ax
  1996.     inc    ax
  1997. cmp_return:
  1998.     pop    si
  1999.     pop    di
  2000.     cld
  2001.     ret
  2002. ;
  2003.     intrdef $dsb        ;subtract secondary from primary
  2004.     mov    bx,flsec
  2005.     xor    byte ptr [bx],80H    ;flip sign of secondary
  2006.                     ;and fall thru into add routine
  2007. ;
  2008.     intrdef $dad        ;add secondary to primary
  2009.     pushf
  2010.     push    bp
  2011.     push    si
  2012.     push    di
  2013.     std
  2014.     mov    si,flprm
  2015.     mov    di,ds
  2016.     mov    es,di
  2017.     mov    di,flsec
  2018.     mov    cx,word ptr -2[si]    ;get exponent of primary
  2019.     sub    cx,word ptr -2[di]    ;compute magnitude difference
  2020.     jae    order_ok
  2021.     xchg    si,di        ;make largest number primary
  2022.     mov    flprm,si
  2023.     mov    flsec,di
  2024.     neg    cx        ;fix exponent difference
  2025. order_ok:
  2026.     cmp    cx,60        ;see if numbers overlap
  2027.     jna    add_ok        ;no overlap just return largest number
  2028.     pop    di
  2029.     pop    si
  2030.     pop    bp
  2031.     popf
  2032.     ret
  2033. add_ok:
  2034.     lea    si,-3[di]
  2035.     mov    di,offset temp+7
  2036.     sub    al,al
  2037. cx_check:
  2038.     cmp    cx,8        ;more than a byte to shift ?
  2039.     jb    shift_it    ;no, then shift remaining part over
  2040.     stos    byte ptr [di]
  2041.     sub    cx,8
  2042.     jmp    cx_check
  2043. shift_it:
  2044.     sub    dl,dl
  2045. shift_loop:
  2046.     mov    ah,dl
  2047.     lods    byte ptr [si]
  2048.     mov    dl,al
  2049.     shr    ax,cl
  2050.     stos    byte ptr [di]
  2051.     cmp    di,offset temp
  2052.     jae    shift_loop
  2053. ;
  2054.     mov    si,flprm
  2055.     mov    di,flsec
  2056.     mov    cx,4            ;load up for loops below
  2057.     mov    al,byte ptr [di]
  2058.     xor    al,byte ptr [si]
  2059.     jns    signs_same
  2060.     test    byte ptr [di],80H    ;check which is negative
  2061.     jnz    sub_s_from_p
  2062. ;
  2063. ; subtract primary from secondary
  2064. ;
  2065.     clc
  2066.     mov    bx,0
  2067. sub_loop_1:
  2068.     mov    ax,temp[bx]
  2069.     sbb    ax,word ptr -10[bx][si]
  2070.     mov    word ptr -10[bx][si],ax
  2071.     inc    bx
  2072.     inc    bx
  2073.     loop    sub_loop_1
  2074.     jmp    short check_sign
  2075. ;
  2076. ; subtract secondary from primary
  2077. ;
  2078. sub_s_from_p:
  2079.     clc
  2080.     mov    bx,0
  2081. sub_loop_2:
  2082.     mov    ax,temp[bx]
  2083.     sbb    word ptr -10[bx][si],ax
  2084.     inc    bx
  2085.     inc    bx
  2086.     loop    sub_loop_2
  2087. check_sign:
  2088.     mov    byte ptr [si],0        ;mark result as positive
  2089.     jnb    do_normalize
  2090.     mov    byte ptr [si],0FFH    ;mark result as negative
  2091.     clc
  2092.     mov    bx,0
  2093.     mov    cx,4
  2094. neg_loop:
  2095.     mov    ax,0
  2096.     sbb    ax,word ptr -10[bx][si]
  2097.     mov    word ptr -10[bx][si],ax
  2098.     inc    bx
  2099.     inc    bx
  2100.     loop    neg_loop
  2101.     jmp    short do_normalize
  2102. ;
  2103. ; signs of numbers are the same just add them together
  2104. ;
  2105. signs_same:
  2106.     clc
  2107.     mov    bx,0
  2108. add_loop:
  2109.     mov    ax,temp[bx]
  2110.     adc    word ptr -10[bx][si],ax
  2111.     inc    bx
  2112.     inc    bx
  2113.     loop    add_loop
  2114. ;
  2115. ; normalize number such that first byte of number is >= 0x10
  2116. ; and < 0x20
  2117. ;
  2118. do_normalize:
  2119.     mov    si,flprm
  2120.     lea    bx,-3[si]
  2121.     lea    bp,-10[si]
  2122.     mov    dx,word ptr -2[si]    ;get exponent
  2123. byte_loop:
  2124.     cmp    byte ptr [bx],0
  2125.     jne    bskip_done
  2126.     dec    bx
  2127.     sub    dx,8
  2128.     cmp    bx,bp
  2129.     jae    byte_loop
  2130. ;
  2131. ;    number is zero
  2132. ;
  2133. zero_result:
  2134.     mov    di,ds
  2135.     mov    es,di
  2136.     mov    di,flprm
  2137.     sub    ax,ax
  2138.     mov    cx,6
  2139. rep    stos    word ptr [di]
  2140.     pop    di
  2141.     pop    si
  2142.     pop    bp
  2143.     popf
  2144.     ret
  2145.  
  2146. bskip_done:
  2147.     sub    cx,cx
  2148.     lea    di,-3[si]
  2149.     mov    ah,byte ptr [bx]
  2150.     dec    bx
  2151.     cmp    ah,20H
  2152.     jnb    too_big
  2153. ;
  2154.     mov    al,byte ptr [bx]
  2155.     mov    ch,al
  2156. left_count:
  2157.     cmp    ah,10H
  2158.     jae    move_left
  2159.     shl    ax,1
  2160.     inc    cl
  2161.     dec    dx
  2162.     jmp    left_count
  2163. move_left:
  2164.     mov    [di],ah
  2165.     dec    di
  2166.     dec    bx
  2167.     cmp    bx,bp
  2168.     jb    clear_tail
  2169.     mov    ah,ch
  2170.     mov    al,byte ptr [bx]
  2171.     mov    ch,al
  2172.     shl    ax,cl
  2173.     jmp    move_left
  2174. ;
  2175. ;
  2176. too_big:
  2177.     mov    al,ah
  2178.     sub    ah,ah
  2179.     mov    ch,al
  2180. right_count:
  2181.     inc    cl
  2182.     inc    dx
  2183.     shr    ax,1
  2184.     cmp    al,20H
  2185.     jnb    right_count
  2186. move_right:
  2187.     stos    byte ptr [di]
  2188.     cmp    bx,bp
  2189.     jb    clear_tail
  2190.     mov    ah,ch
  2191.     mov    al,byte ptr [bx]
  2192.     dec    bx
  2193.     mov    ch,al
  2194.     shr    ax,cl
  2195.     jmp    move_right
  2196. ;
  2197. clear_tail:
  2198.     mov    cx,di
  2199.     sub    cx,bp
  2200.     inc    cx
  2201.     jcxz    norm_done
  2202.     sub    al,al
  2203. rep    stos    byte ptr [di]
  2204. ;
  2205. norm_done:
  2206. ;
  2207. ; overflow/underflow checking needs to be done here
  2208. ;
  2209.     cmp    dx,0
  2210.     ja    no_under
  2211.     mov    flterr_,UNDER_FLOW
  2212.     mov    word ptr -2[si],1
  2213.     jmp    short clr_fraction
  2214. no_under:
  2215.     cmp    dx,2048
  2216.     jb    no_over
  2217.     mov    flterr_,OVER_FLOW
  2218.     mov    word ptr -2[si],2047
  2219. clr_fraction:
  2220.     mov    word ptr -4[si],1000H
  2221.     lea    di,-6[si]
  2222.     sub    ax,ax
  2223.     stos    word ptr [di]
  2224.     stos    word ptr [di]
  2225.     stos    word ptr [di]
  2226.     jmp    fault_handler
  2227. no_over:
  2228.     mov    word ptr -2[si],dx    ;save new value of exponent
  2229.     pop    di
  2230.     pop    si
  2231.     pop    bp
  2232.     popf
  2233.     ret
  2234. ;
  2235.     intrdef $ddv
  2236.         ;double floating divide    (primary = primary/secondary)
  2237.     pushf
  2238.     push    bp
  2239.     push    si
  2240.     push    di
  2241.     std
  2242.     mov    di,ds
  2243.     mov    es,di
  2244.     mov    bp,flprm
  2245.     mov    bx,flsec
  2246.     mov    ax,ds:-2[bp]
  2247.     test    ax,ax
  2248.     jnz    not_zero
  2249.     jmp    zero_result
  2250. not_zero:
  2251.     mov    dx,-2[bx]
  2252.     test    dx,dx
  2253.     jnz    div_ok
  2254.     mov    flterr_,DIV_BY_ZERO
  2255.     jmp    fault_handler
  2256. div_ok:
  2257.     sub    ax,dx
  2258.     add    ax,1019        ;exp = Ep - Es
  2259.     mov    ds:-2[bp],ax
  2260.     mov    al,byte ptr [bx]
  2261.     xor    ds:byte ptr [bp],al
  2262. ;
  2263.     mov    ax,-6[bx]    ;check if easy divide case
  2264.     or    ax,-8[bx]
  2265.     or    ax,-10[bx]
  2266.     jnz    hard_div
  2267. ;
  2268.     mov    si,-4[bx]
  2269.     lea    di,ds:-4[bp]
  2270.     mov    cx,3
  2271.     mov    dx,[di]
  2272.     cmp    dx,si
  2273.     jb    ediv_loop
  2274.     shl    si,1
  2275.     inc    ds:word ptr -2[bp]        ;adjust exponent
  2276. ediv_loop:
  2277.     mov    ax,-2[di]
  2278.     div    si
  2279.     stos    word ptr [di]
  2280.     loop    ediv_loop
  2281. ;    sub    ax,ax
  2282.     xchg    ax,dx
  2283.     sub    dx,dx
  2284.     div    si
  2285.     stos    word ptr [di]
  2286.     jmp    do_normalize
  2287. ;
  2288. hard_div:
  2289.     lea    si,ds:-4[bp]
  2290.     lea    di,-4[bx]
  2291.     mov    cx,4
  2292. repe    cmps    acc1, es:acc2
  2293.     jne    do_div
  2294. ;                numbers are the same so answer is 1
  2295.     add    ds:word ptr -2[bp],4    ;adjust exponent
  2296.     lea    di,ds:-4[bp]
  2297.     mov    ax,1000H
  2298.     stos    es:acc1
  2299.     sub    ax,ax
  2300.     stos    es:acc1
  2301.     stos    es:acc1
  2302.     stos    es:acc1
  2303.     mov    si,bp
  2304.     mov    dx,word ptr -2[si]
  2305.     jmp    norm_done
  2306. ;
  2307. do_div:
  2308.     mov    ax,ds:-10[bp]
  2309.     mov    dx,ds:-8[bp]
  2310.     mov    si,ds:-6[bp]
  2311.     mov    di,ds:-4[bp]
  2312.     jb    dont_shift
  2313.     inc    ds:word ptr -2[bp]    ;fix exponent
  2314.     shr    di,1
  2315.     rcr    si,1
  2316.     rcr    dx,1
  2317.     rcr    ax,1
  2318. dont_shift:
  2319.     sub    cx,cx
  2320.     sub    bp,4
  2321.     mov    loop_count,4
  2322. bdiv_loop:
  2323.     mov    lcnt1,16
  2324. div_loop:
  2325.     shl    cx,1
  2326.     shl    ax,1
  2327.     rcl    dx,1
  2328.     rcl    si,1
  2329.     rcl    di,1
  2330.     sub    ax,word ptr -10[bx]
  2331.     sbb    dx,word ptr -8[bx]
  2332.     sbb    si,word ptr -6[bx]
  2333.     sbb    di,word ptr -4[bx]
  2334.     js    zero_bit
  2335. one_bit:
  2336.     inc    cx        ;set bit in quotient
  2337.     dec    lcnt1
  2338.     jnz    div_loop
  2339.     mov    ds:word ptr [bp],cx
  2340.     sub    bp,2
  2341.     sub    cx,cx
  2342.     dec    loop_count
  2343.     jnz    bdiv_loop
  2344.     jmp    do_normalize
  2345. ;
  2346. bzero_loop:
  2347.     mov    lcnt1,16
  2348. zero_loop:
  2349.     shl    cx,1
  2350.     shl    ax,1
  2351.     rcl    dx,1
  2352.     rcl    si,1
  2353.     rcl    di,1
  2354.     add    ax,word ptr -10[bx]
  2355.     adc    dx,word ptr -8[bx]
  2356.     adc    si,word ptr -6[bx]
  2357.     adc    di,word ptr -4[bx]
  2358.     jns    one_bit
  2359. zero_bit:
  2360.     dec    lcnt1
  2361.     jnz    zero_loop
  2362.     mov    ds:word ptr [bp],cx
  2363.     sub    bp,2
  2364.     sub    cx,cx
  2365.     dec    loop_count
  2366.     jnz    bzero_loop
  2367.     jmp    do_normalize
  2368. ;
  2369. ;
  2370.     intrdef $dml
  2371.         ;double floating multiply    (primary = primary * secondary)
  2372.     pushf
  2373.     push    bp
  2374.     push    si
  2375.     push    di
  2376.     std
  2377.     mov    si,flprm
  2378.     mov    bx,flsec
  2379.     mov    ax,-2[si]
  2380.     test    ax,ax
  2381.     jnz    prm_not_zero
  2382.     jmp    zero_result
  2383. prm_not_zero:
  2384.     mov    dx,-2[bx]
  2385.     test    dx,dx
  2386.     jnz    alt_not_zero
  2387.     jmp    zero_result
  2388. alt_not_zero:
  2389.     add    ax,dx
  2390.     sub    ax,1019
  2391.     mov    -2[si],ax
  2392.     mov    al,byte ptr [bx]
  2393.     xor    byte ptr [si],al
  2394.     sub    ax,ax
  2395.     mov    cx,5
  2396.     mov    di,ds
  2397.     mov    es,di
  2398.     mov    di,offset temp+6
  2399. rep    stos    word ptr [di]        ;clear result
  2400. ;
  2401.     mov    cx,-10[bx]
  2402.     test    cx,cx
  2403.     jz    skip1
  2404.     mov    ax,-6[si]
  2405.     test    ax,ax
  2406.     jz    skip11
  2407.     mul    cx
  2408.     mov    temp-2,dx
  2409. skip11:
  2410.     mov    ax,-4[si]
  2411.     test    ax,ax
  2412.     jz    skip1
  2413.     mul    cx
  2414.     add    temp-2,ax
  2415.     adc    temp,dx
  2416. skip1:
  2417.     mov    cx,-8[bx]
  2418.     test    cx,cx
  2419.     jz    skip2
  2420.     mov    ax,-8[si]
  2421.     test    ax,ax
  2422.     jz    skip2x
  2423.     mul    cx
  2424.     add    temp-2,dx
  2425.     adc    temp,0
  2426.     adc    temp+2,0
  2427. skip2x:
  2428.     mov    ax,-6[si]
  2429.     test    ax,ax
  2430.     jz    skip21
  2431.     mul    cx
  2432.     add    temp-2,ax
  2433.     adc    temp,dx
  2434.     adc    temp+2,0
  2435. skip21:
  2436.     mov    ax,-4[si]
  2437.     test    ax,ax
  2438.     jz    skip2
  2439.     mul    cx
  2440.     add    temp,ax
  2441.     adc    temp+2,dx
  2442.     adc    temp+4,0
  2443. skip2:
  2444.     mov    cx,-6[bx]
  2445.     test    cx,cx
  2446.     jz    skip3
  2447.     mov    ax,-10[si]
  2448.     test    ax,ax
  2449.     jz    skip3x
  2450.     mul    cx
  2451.     add    temp-2,dx
  2452.     adc    temp,0
  2453.     adc    temp+2,0
  2454.     adc    temp+4,0
  2455. skip3x:
  2456.     mov    ax,-8[si]
  2457.     test    ax,ax
  2458.     jz    skip31
  2459.     mul    cx
  2460.     add    temp-2,ax
  2461.     adc    temp,dx
  2462.     adc    temp+2,0
  2463.     adc    temp+4,0
  2464. skip31:
  2465.     mov    ax,-6[si]
  2466.     test    ax,ax
  2467.     jz    skip32
  2468.     mul    cx
  2469.     add    temp,ax
  2470.     adc    temp+2,dx
  2471.     adc    temp+4,0
  2472. skip32:
  2473.     mov    ax,-4[si]
  2474.     test    ax,ax
  2475.     jz    skip3
  2476.     mul    cx
  2477.     add    temp+2,ax
  2478.     adc    temp+4,dx
  2479.     adc    temp+6,0
  2480. skip3:
  2481.     mov    cx,-4[bx]
  2482.     test    cx,cx
  2483.     jz    skip4
  2484.     mov    ax,-10[si]
  2485.     test    ax,ax
  2486.     jz    skip41
  2487.     mul    cx
  2488.     add    temp-2,ax
  2489.     adc    temp,dx
  2490.     adc    temp+2,0
  2491.     adc    temp+4,0
  2492.     adc    temp+6,0
  2493. skip41:
  2494.     mov    ax,-8[si]
  2495.     test    ax,ax
  2496.     jz    skip42
  2497.     mul    cx
  2498.     add    temp,ax
  2499.     adc    temp+2,dx
  2500.     adc    temp+4,0
  2501.     adc    temp+6,0
  2502. skip42:
  2503.     mov    ax,-6[si]
  2504.     test    ax,ax
  2505.     jz    skip43
  2506.     mul    cx
  2507.     add    temp+2,ax
  2508.     adc    temp+4,dx
  2509.     adc    temp+6,0
  2510. skip43:
  2511.     mov    ax,-4[si]
  2512.     test    ax,ax
  2513.     jz    skip4
  2514.     mul    cx
  2515.     add    temp+4,ax
  2516.     adc    temp+6,dx
  2517. skip4:
  2518.     cmp    temp-2,8000H
  2519.     jb    noround
  2520.     add    temp,1
  2521.     adc    temp+2,0
  2522.     adc    temp+4,0
  2523.     adc    temp+6,0
  2524. noround:
  2525.     lea    di,-4[si]
  2526.     mov    si,offset temp+6
  2527.     mov    cx,4
  2528. rep    movs    word ptr [di], word ptr [si]
  2529.     jmp    do_normalize
  2530. ;
  2531.     intrdef $utod
  2532.     pushf
  2533.     push    bp
  2534.     push    si
  2535.     push    di
  2536.     std
  2537.     mov    di,ds
  2538.     mov    es,di
  2539.     mov    di,flprm
  2540.     mov    byte ptr [di],0        ;make sign positive
  2541.     mov    word ptr -2[di],1023+12    ;set exponent
  2542.     sub    di,4
  2543.     stos    word ptr [di]
  2544.     sub    ax,ax
  2545.     stos    word ptr [di]
  2546.     stos    word ptr [di]
  2547.     stos    word ptr [di]
  2548.     jmp    do_normalize
  2549. ;
  2550.     intrdef $itod
  2551.     pushf
  2552.     push    bp
  2553.     push    si
  2554.     push    di
  2555.     std
  2556.     mov di,ds
  2557.     mov es,di
  2558.     mov    di,flprm
  2559.     mov    byte ptr [di],0        ;make sign positive
  2560.     mov    word ptr -2[di],1023+12    ;set exponent
  2561.     test    ax,ax
  2562.     jns    pos_int
  2563.     neg    ax
  2564.     mov    byte ptr [di],80H    ;make sign negative
  2565. pos_int:
  2566.     sub    di,4
  2567.     stos    word ptr [di]
  2568.     sub    ax,ax
  2569.     stos    word ptr [di]
  2570.     stos    word ptr [di]
  2571.     stos    word ptr [di]
  2572.     jmp    do_normalize
  2573. ;
  2574. dornd    proc    near
  2575.         ; round the number in the primary accumulator
  2576.     mov    di,flprm
  2577.     mov    al,byte ptr -10[di]
  2578.     mov    byte ptr -10[di],0
  2579.     cmp    al,80H
  2580.     jb    rndexit
  2581.     jne    round_up
  2582.     or    byte ptr -9[di],1    ;round up on even, down on odd
  2583. rndexit:
  2584.     ret
  2585. round_up:
  2586.     add    byte ptr -9[di],1
  2587.     adc    word ptr -8[di],0
  2588.     adc    word ptr -6[di],0
  2589.     adc    word ptr -4[di],0
  2590.     cmp    byte ptr -3[di],20h
  2591.     jb    rndexit
  2592.     inc    word ptr -2[di]        ;bump exponent
  2593.     shr    word ptr -4[di],1    ;and re-normalize number
  2594.     rcr    word ptr -6[di],1
  2595.     rcr    word ptr -8[di],1
  2596.     rcr    word ptr -10[di],1
  2597.     ret
  2598. dornd    endp
  2599. ;
  2600.     intrdef $xtod
  2601.     pushf
  2602.     push    bp
  2603.     push    si
  2604.     push    di
  2605.     std
  2606.     mov di,ds
  2607.     mov es,di
  2608.     mov    di,flprm
  2609.     mov    byte ptr [di],0        ;make sign positive
  2610.     mov    word ptr -2[di],1023+28    ;set exponent
  2611.     test    dx,dx
  2612.     jns    pos_long
  2613.     neg    dx
  2614.     neg    ax
  2615.     sbb    dx,0
  2616.     mov    byte ptr [di],80H    ;make sign negative
  2617. pos_long:
  2618.     sub    di,4
  2619.     xchg    ax,dx
  2620.     stos    word ptr [di]
  2621.     xchg    ax,dx
  2622.     stos    word ptr [di]
  2623.     sub    ax,ax
  2624.     stos    word ptr [di]
  2625.     stos    word ptr [di]
  2626.     jmp    do_normalize
  2627. ;
  2628.     intrdef $dtou
  2629.     intrdef $dtoi
  2630.     intrdef $dtox
  2631.     push    si
  2632.     push    di
  2633.     mov    si,flprm
  2634.     sub    ax,ax
  2635.     mov    temp,ax
  2636.     mov    temp+2,ax
  2637.     mov    temp+4,ax
  2638.     mov    temp+6,ax
  2639.     mov    ax,word ptr -2[si]
  2640.     sub    ax,1023
  2641.     js    d2x_zero
  2642.     cmp    ax,54
  2643.     jae    d2x_zero
  2644.     mov    di,ds
  2645.     mov    es,di
  2646.     mov    di,offset temp
  2647.     sub    bx,bx
  2648.     mov    cx,ax
  2649.     mov    ax,4
  2650. d2x_count:
  2651.     sub    cx,ax
  2652.     jbe    d2x_cdone
  2653.     dec    bx
  2654.     mov    ax,8
  2655.     jmp    d2x_count
  2656. d2x_cdone:
  2657.     mov    dl,byte ptr -3[si][bx]
  2658.     mov    byte ptr [di],dl
  2659.     inc    di
  2660.     inc    bx
  2661.     jle    d2x_cdone
  2662.     neg    cx
  2663.     mov    ax,temp
  2664.     mov    dx,temp+2
  2665.     jcxz    d2x_nshift
  2666. d2x_shift:
  2667.     shr    dx,1
  2668.     rcr    ax,1
  2669.     loop    d2x_shift
  2670. d2x_nshift:
  2671.     test    byte ptr [si],80H
  2672.     jz    d2x_ret
  2673.     neg    dx
  2674.     neg    ax
  2675.     sbb    dx,0
  2676. d2x_ret:
  2677.     pop    di
  2678.     pop    si
  2679.     ret
  2680.  
  2681. d2x_zero:
  2682.     sub    ax,ax
  2683.     sub    dx,dx
  2684.     pop    di
  2685.     pop    si
  2686.     ret
  2687. ;
  2688. ;
  2689. fault_handler:
  2690.     pop    di
  2691.     pop    si
  2692.     pop    bp
  2693.     popf
  2694.     ret
  2695. ;
  2696. ifndef INTERNAL
  2697. $floats    endp
  2698.     finish
  2699.     end
  2700. endif
  2701. sqrt87.asm
  2702. ;    Copyright (C) 1983 by Manx Software Systems
  2703. ; :ts=8
  2704.     include lmacros.h
  2705.  
  2706. dataseg    segment word public 'data'
  2707. status    dw    ?
  2708.     extrn    chop_ctl:word, round_ctl:word
  2709.     extrn    errno_:word
  2710. dataseg    ends
  2711.     assume    ds:dataseg
  2712.  
  2713. ERANGE    equ    -20
  2714. EDOM    equ    -21
  2715.  
  2716.     procdef    sqrt, <<doub,cdouble>>
  2717. ;
  2718. ;        double sqrt(d)
  2719. ;
  2720.     wait
  2721.     db    0dbh,0e3h    ;finit
  2722.     wait
  2723.     esc    40,doub        ;fld qword ptr doub
  2724.     wait
  2725.     db    0d9h,0e4h    ;ftst
  2726.     wait
  2727.     esc    47,status    ;fstsw exponent
  2728.     mov    ah,byte ptr status+1
  2729.     sahf
  2730.     jnb    sqrt_ok
  2731.     wait
  2732.     db    0d9h,0e0h    ;fchs
  2733.     mov    errno_,EDOM
  2734.     wait
  2735. sqrt_ok:
  2736.     db    0d9h,0fah    ;fsqrt
  2737.     pret
  2738.     pend    sqrt
  2739.     finish
  2740.     end
  2741. frexp87.asm
  2742. ;    Copyright (C) 1983 by Manx Software Systems
  2743. ; :ts=8
  2744. ;    the psuedo accumlators are formated as follows:
  2745. ;    -10    -8    -6    -4    -2    0
  2746. ;    |grd + LS ----- fraction ---- MS |  exp | sign
  2747. ;
  2748. ;    floating point system error codes:
  2749. UNDER_FLOW    equ    1
  2750. OVER_FLOW    equ    2
  2751. DIV_BY_ZERO    equ    3
  2752. ;
  2753.     include    lmacros.h
  2754. ifndef FARPROC
  2755.     extrn    $isnan:near
  2756. else
  2757.     extrn    $isnan:far
  2758. endif
  2759.  
  2760. dataseg    segment word public 'data'
  2761. status    dw    ?
  2762.     extrn    chop_ctl:word, round_ctl:word
  2763. dataseg    ends
  2764.     assume    ds:dataseg
  2765.  
  2766.     procdef isnan,<<ddd,cdouble>>
  2767.     wait
  2768.     db    0dbh,0e3h    ;finit
  2769.     wait    
  2770.     esc    40,ddd        ;fld    qword ptr 4[bp]
  2771.     wait
  2772.     call    $isnan
  2773.     pret
  2774.     pend    isnan
  2775.  
  2776.     procdef    frexp,<<d,cdouble>,<i,ptr>>
  2777. ;
  2778. ;        frexp(d, &i)
  2779. ;            returns 0 <= x < 1
  2780. ;            such that: d = x * 2^i
  2781.     wait
  2782.     db    0dbh,0e3h    ;finit
  2783.     wait
  2784.     db    0d9h,0e8h    ;fld1
  2785.     wait
  2786.     db    0d9h,0e0h    ;fchs
  2787.     wait
  2788.     esc    40,d        ;fld qword ptr 4[bp]
  2789.     wait
  2790.     db    0d9h,0e4h    ;ftst
  2791.     wait
  2792.     esc    47,status    ;fstsw exponent
  2793.     mov    ah,byte ptr status+1
  2794.     sahf
  2795.     je    zero
  2796.     wait
  2797.     db    0d9h,0f4h    ;fxtract
  2798.     wait
  2799.     db    0d9h,0c9h    ;fxch
  2800.     wait
  2801.     db    0d8h,0e2h    ;fsub    st,st(2)
  2802.     ldptr    bx,i,es
  2803.     wait
  2804. ifdef LONGPTR
  2805.     esc    59,es:[bx]    ;fistp word ptr [bx]
  2806. else
  2807.     esc    59,ds:[bx]    ;fistp word ptr [bx]
  2808. endif
  2809.     wait
  2810.     db    0d9h,0fdh    ;fscale
  2811.     pret
  2812. zero:
  2813.     ldptr    bx,i,es
  2814. ifdef LONGPTR
  2815.     mov    es:word ptr [bx],0
  2816. else
  2817.     mov    ds:word ptr [bx],0
  2818. endif
  2819.     pret
  2820.     pend    frexp
  2821. ;
  2822. ;    ldexp(d, i)
  2823. ;        returns x = d * 2^i
  2824.     procdef    ldexp, <<dou,cdouble>,<ii,word>>
  2825.     wait
  2826.     db    0dbh,0e3h    ;finit
  2827.     wait
  2828.     esc    56,ii        ;fild word ptr 12[bp]
  2829.     wait
  2830.     esc    40,dou        ;fld qword ptr 4[bp]
  2831.     wait
  2832.     db    0d9h,0fdh    ;fscale
  2833.     pret
  2834.     pend    ldexp
  2835. ;
  2836. ;    modf(d, dptr)
  2837. ;        returns fractional part of d, and
  2838. ;        stores integral part into *dptr
  2839.     procdef    modf, <<doub,cdouble>,<dptr,ptr>>
  2840.     wait
  2841.     db    0dbh,0e3h    ;finit
  2842.     wait
  2843.     esc    40,doub        ;fld qword ptr 4[bp]
  2844.     wait
  2845.     db    0d9h,0c0h    ;fld st(0)
  2846.     wait
  2847.     esc    13,chop_ctl    ;fldcw    chop_ctl
  2848.     wait
  2849.     db    0d9h,0fch    ;frndint
  2850.     ldptr    bx,dptr,es
  2851.     wait
  2852.     esc    13,round_ctl    ;fldcw    round_ctl
  2853.     wait
  2854. ifdef LONGPTR
  2855.     esc    42,es:[bx]        ;fst qword ptr [bx]
  2856. else
  2857.     esc    42,ds:[bx]        ;fst qword ptr [bx]
  2858. endif
  2859.     wait
  2860.     db    0deh,0e9h    ;fsub
  2861.     pret
  2862.     pend    modf
  2863.     finish
  2864.     end
  2865. fsubs87.asm
  2866. ifndef INTERNAL
  2867. ;    Copyright (C) 1983 by Manx Software Systems
  2868. ;    page    54,130
  2869. ; :ts=8
  2870. ;    floating point system error codes:
  2871.     include    lmacros.h
  2872. UNDER_FLOW    equ    1
  2873. OVER_FLOW    equ    2
  2874. DIV_BY_ZERO    equ    3
  2875. ;
  2876.     internal $floats
  2877.  
  2878. dataseg    segment word public 'data'
  2879.     public    flterr_
  2880. flterr_ dw    0
  2881. second    db    8 dup (?)
  2882. work    dw    4 dup (?)
  2883. status    dw    0
  2884.     public    chop_ctl, round_ctl, rdown_ctl
  2885. chop_ctl dw    0fbfH        ;control word for Chop mode
  2886. round_ctl dw    03bfH        ;control word for Round nearest mode
  2887. rdown_ctl dw    07bfh        ;control word for Round Down mode
  2888. dataseg    ends
  2889. ifdef LONGPTR
  2890.     assume    ds:dataseg
  2891. else
  2892.     assume    ds:dataseg,es:dataseg,ss:dataseg
  2893. endif
  2894. ifdef FARPROC
  2895. frame    equ    4
  2896. else
  2897. frame    equ    2
  2898. endif
  2899.  
  2900. endif
  2901.     intrdef $isnan
  2902.     wait
  2903.     db    0d9h,0e5h    ;fxam
  2904.     wait
  2905.     esc    47,status    ;fstsw    status
  2906.     wait
  2907.     mov    ah,byte ptr status+1
  2908.     and    ah,047h
  2909.     cmp    ah,1
  2910.     jz    lnan
  2911.     cmp    ah,2
  2912.     jz    lnan
  2913.     cmp    ah,5
  2914.     jz    linf
  2915.     cmp    ah,7
  2916.     jz    linf
  2917.     sub    ax,ax
  2918.     ret
  2919. lnan:
  2920.     sub    ax,ax
  2921.     inc    ax
  2922.     ret
  2923. linf:
  2924.     sub    ax,ax
  2925.     inc    ax
  2926.     inc    ax
  2927.     ret
  2928.  
  2929.     intrdef $flds        ;load single float into secondary accum
  2930. ifndef LONGPTR
  2931.     mov    ax,ds
  2932.     mov    es,ax
  2933. endif
  2934.     wait
  2935.     esc    8,es:[bx]    ;fld    dword ptr [bx]
  2936.     wait
  2937.     esc    43,second    ;fstp    qword ptr second
  2938.     ret
  2939.  
  2940. ifdef LONGPTR
  2941.     intrdef $fldsss    ;load single float into secondary accum
  2942.     wait
  2943.     esc    8,ss:[bx]    ;fld    dword ptr [bx]
  2944.     wait
  2945.     esc    43,second    ;fstp    qword ptr second
  2946.     ret
  2947.  
  2948.     intrdef $fldsds    ;load single float into secondary accum
  2949.     wait
  2950.     esc    8,ds:[bx]    ;fld    dword ptr [bx]
  2951.     wait
  2952.     esc    43,second    ;fstp    qword ptr second
  2953.     ret
  2954. endif
  2955. ;
  2956.     intrdef $fldp        ;load single float into primary accum
  2957. ifndef LONGPTR
  2958.     mov    ax,ds
  2959.     mov    es,ax
  2960. endif
  2961.     wait
  2962.     db    0dbh,0e3h    ;finit
  2963.     wait
  2964.     esc    8,es:[bx]    ;fld    dword ptr [bx]
  2965.     ret
  2966. ;
  2967. ifdef LONGPTR
  2968.     intrdef $fldpss    ;load single float into primary accum
  2969.     wait
  2970.     db    0dbh,0e3h    ;finit
  2971.     wait
  2972.     esc    8,ss:[bx]    ;fld    dword ptr [bx]
  2973.     ret
  2974. ;
  2975.     intrdef $fldpds    ;load single float into primary accum
  2976.     wait
  2977.     db    0dbh,0e3h    ;finit
  2978.     wait
  2979.     esc    8,ds:[bx]    ;fld    dword ptr [bx]
  2980.     ret
  2981. endif
  2982. ;
  2983.     intrdef $fst        ;store single at addr in BX
  2984. ifndef LONGPTR
  2985.     mov    ax,ds
  2986.     mov    es,ax
  2987. endif
  2988.     wait
  2989.     esc    10,es:[bx]    ;fst    dword ptr [bx]
  2990.     wait
  2991.     ret
  2992. ;
  2993.     intrdef $fsts        ;store single at addr in BX
  2994. ifndef LONGPTR
  2995.     mov    ax,ds
  2996.     mov    es,ax
  2997. endif
  2998.     wait
  2999.     esc    40,second    ;fld    qword ptr second
  3000.     wait
  3001.     db    0d9h,0c9h    ;fxch
  3002.     wait
  3003.     esc    43,second    ;fstp    qword ptr second
  3004.     wait
  3005.     esc    10,es:[bx]    ;fst    dword ptr [bx]
  3006.     wait
  3007.     esc    40,second    ;fld    qword ptr second
  3008.     wait
  3009.     db    0d9h,0c9h    ;fxch
  3010.     wait
  3011.     esc    43,second    ;fstp    qword ptr second
  3012.     ret
  3013. ;
  3014. ifdef LONGPTR
  3015.     intrdef $fstss        ;store single at addr in BX
  3016.     wait
  3017.     esc    10,ss:[bx]    ;fst    dword ptr [bx]
  3018.     wait
  3019.     ret
  3020. ;
  3021.     intrdef $fstds        ;store single at addr in BX
  3022.     wait
  3023.     esc    40,second    ;fld    qword ptr second
  3024.     wait
  3025.     db    0d9h,0c9h    ;fxch
  3026.     wait
  3027.     esc    43,second    ;fstp    qword ptr second
  3028.     wait
  3029.     esc    10,ds:[bx]    ;fst    dword ptr [bx]
  3030.     wait
  3031.     esc    40,second    ;fld    qword ptr second
  3032.     wait
  3033.     db    0d9h,0c9h    ;fxch
  3034.     wait
  3035.     esc    43,second    ;fstp    qword ptr second
  3036.     ret
  3037.  
  3038.     intrdef $fstsss        ;store single at addr in BX
  3039.     wait
  3040.     esc    40,second    ;fld    qword ptr second
  3041.     wait
  3042.     db    0d9h,0c9h    ;fxch
  3043.     wait
  3044.     esc    43,second    ;fstp    qword ptr second
  3045.     wait
  3046.     esc    10,ss:[bx]    ;fst    dword ptr [bx]
  3047.     wait
  3048.     esc    40,second    ;fld    qword ptr second
  3049.     wait
  3050.     db    0d9h,0c9h    ;fxch
  3051.     wait
  3052.     esc    43,second    ;fstp    qword ptr second
  3053.     ret
  3054. ;
  3055.     intrdef $fstsds        ;store single at addr in BX
  3056.     wait
  3057.     esc    10,ds:[bx]    ;fst    dword ptr [bx]
  3058.     wait
  3059.     ret
  3060. endif
  3061. ;
  3062.     intrdef $dlis        ;load double immediate secondary
  3063.     pop    bx
  3064. ifdef FARPROC
  3065.     pop    dx
  3066. endif
  3067.     push    di
  3068.     push    si
  3069.     mov    di,ds
  3070.     mov    es,di
  3071.     mov    di,offset second
  3072.     mov    si,bx        ;get return addr
  3073.     mov    cx,4
  3074. ifdef FARPROC
  3075.     push    ds
  3076.     mov    ds,dx
  3077. lis_lp:            ;8086 doesn't handle double prefixes
  3078.     movs    word ptr [di], word ptr [si]
  3079. else
  3080. lis_lp:            ;8086 doesn't handle double prefixes
  3081.     movs    word ptr [di], cs:word ptr [si]
  3082. endif
  3083.     loop    lis_lp
  3084.     mov    bx,si
  3085. ifdef FARPROC
  3086.     pop    ds
  3087. endif
  3088.     pop    si
  3089.     pop    di
  3090. ifdef FARPROC
  3091.     push    dx
  3092.     push    bx
  3093.     ret
  3094. else
  3095.     jmp    bx
  3096. endif
  3097.  
  3098. ;
  3099. ifdef LONGPTR
  3100.     intrdef $dldsss
  3101.     mov    cx,ss
  3102.     mov    es,cx
  3103.     jmp    dodlds
  3104.  
  3105.     intrdef $dldsds
  3106.     push    di
  3107.     push    si
  3108.     push    ds
  3109.     mov    cx,ds
  3110.     mov    es,cx
  3111.     jmp    dodldsx
  3112. endif
  3113.     intrdef $dlds        ;load double float into secondary accum
  3114. dodlds:
  3115.     push    di
  3116.     push    si
  3117. ifdef LONGPTR
  3118.     push    ds
  3119.     mov    di,ds
  3120.     mov    si,es
  3121.     mov    ds,si
  3122.     mov    es,di
  3123. else
  3124.     mov    di,ds
  3125.     mov    es,di
  3126. endif
  3127. dodldsx:
  3128.     mov    di,offset second
  3129.     mov    si,bx
  3130.     mov    cx,4
  3131. rep    movsw
  3132.     popds
  3133.     pop    si
  3134.     pop    di
  3135.     ret
  3136. ;
  3137.     intrdef $dlip        ;load double immediate primary
  3138.     wait
  3139.     db    0dbh,0e3h    ;finit
  3140.     pop    bx
  3141. ifdef FARPROC
  3142. ifndef LONGPTR
  3143.     mov cx,es
  3144. endif
  3145.     pop    es
  3146.     wait
  3147.     esc    40,es:[bx]    ;fld    cs:qword ptr [bx]
  3148.     add    bx,8
  3149.     push    es
  3150.     push    bx
  3151. ifndef LONGPTR
  3152.     mov    es,cx
  3153. endif
  3154.     ret
  3155. else
  3156.     wait
  3157.     esc    40,cs:[bx]    ;fld    cs:qword ptr [bx]
  3158.     add    bx,8
  3159.     jmp    bx
  3160. endif
  3161. ;
  3162. ifdef LONGPTR
  3163.     intrdef $dldpss    ;load double float into primary accum
  3164.     wait
  3165.     db    0dbh,0e3h    ;finit
  3166.     wait
  3167.     esc    40,ss:[bx]    ;fld    qword ptr [bx]
  3168.     ret
  3169.  
  3170.     intrdef $dldpds    ;load double float into primary accum
  3171.     wait
  3172.     db    0dbh,0e3h    ;finit
  3173.     wait
  3174.     esc    40,ds:[bx]    ;fld    qword ptr [bx]
  3175.     ret
  3176. endif
  3177.     intrdef $dldp        ;load double float into primary accum
  3178. ifndef LONGPTR
  3179.     mov    ax,ds
  3180.     mov    es,ax
  3181. endif
  3182.     wait
  3183.     db    0dbh,0e3h    ;finit
  3184.     wait
  3185.     esc    40,es:[bx]    ;fld    qword ptr [bx]
  3186.     ret
  3187. ;
  3188.     intrdef $dsts
  3189.     wait
  3190.     esc    40,second    ;fld    qword ptr second
  3191.     wait
  3192.     db    0d9h,0c9h    ;fxch
  3193.     wait
  3194.     esc    43,second    ;fstp    qword ptr second
  3195.     call    $dst
  3196.     wait
  3197.     esc    40,second    ;fld    qword ptr second
  3198.     wait
  3199.     db    0d9h,0c9h    ;fxch
  3200.     wait
  3201.     esc    43,second    ;fstp    qword ptr second
  3202.     wait
  3203.     ret
  3204.  
  3205.     intrdef $dst        ;store double at addr in BX
  3206. ifndef LONGPTR
  3207.     mov    ax,ds
  3208.     mov    es,ax
  3209. endif
  3210.     wait
  3211.     esc    42,es:[bx]    ;fst    qword ptr [bx]
  3212.     wait
  3213.     ret
  3214. ifdef LONGPTR
  3215.     intrdef $dstss        ;store double at addr in BX
  3216.     wait
  3217.     esc    42,ss:[bx]    ;fst    qword ptr [bx]
  3218.     wait
  3219.     ret
  3220.  
  3221.     intrdef $dstds        ;store double at addr in BX
  3222.     wait
  3223.     esc    42,ds:[bx]    ;fst    qword ptr [bx]
  3224.     wait
  3225.     ret
  3226.  
  3227.     intrdef $dstsss        ;store double at addr in BX
  3228.     wait
  3229.     esc    40,second    ;fld    qword ptr second
  3230.     wait
  3231.     db    0d9h,0c9h    ;fxch
  3232.     wait
  3233.     esc    43,second    ;fstp    qword ptr second
  3234.     wait
  3235.     esc    42,ss:[bx]    ;fst    qword ptr [bx]
  3236.     wait
  3237.     esc    40,second    ;fld    qword ptr second
  3238.     wait
  3239.     db    0d9h,0c9h    ;fxch
  3240.     wait
  3241.     esc    43,second    ;fstp    qword ptr second
  3242.     ret
  3243.  
  3244.     intrdef $dstsds        ;store double at addr in BX
  3245.     wait
  3246.     esc    40,second    ;fld    qword ptr second
  3247.     wait
  3248.     db    0d9h,0c9h    ;fxch
  3249.     wait
  3250.     esc    43,second    ;fstp    qword ptr second
  3251.     wait
  3252.     esc    42,ds:[bx]    ;fst    qword ptr [bx]
  3253.     wait
  3254.     esc    40,second    ;fld    qword ptr second
  3255.     wait
  3256.     db    0d9h,0c9h    ;fxch
  3257.     wait
  3258.     esc    43,second    ;fstp    qword ptr second
  3259.     ret
  3260. endif
  3261. ;
  3262.     intrdef $dpsh        ;push double float onto the stack
  3263.                 ;from the primary accumulator
  3264.     pop    ax        ;fetch return address
  3265. ifdef FARPROC
  3266.     pop    dx
  3267. endif
  3268.     sub    sp,8        ;make room for double on stack
  3269.     mov    bx,sp        ;address of place to store
  3270. ifdef FARPROC
  3271.     push    dx
  3272. endif
  3273.     push    ax        ;put return address back
  3274. ifdef LONGPTR
  3275.     jmp    $dstss
  3276. else
  3277.     jmp    $dst
  3278. endif
  3279. ;
  3280.     intrdef $dpshs        ;push double float onto the stack
  3281.                 ;from the primary accumulator
  3282.     pop    ax        ;fetch return address
  3283. ifdef FARPROC
  3284.     pop    dx
  3285. endif
  3286.     sub    sp,8        ;make room for double on stack
  3287.     mov    bx,sp        ;address of place to store
  3288. ifdef FARPROC
  3289.     push    dx
  3290. endif
  3291.     push    ax        ;put return address back
  3292. ifdef LONGPTR
  3293.     jmp    $dstsss
  3294. else
  3295.     jmp    $dsts
  3296. endif
  3297.     intrdef $dpopp        ;pop double float into secondary accum
  3298.     mov    bx,sp
  3299.     add    bx,frame    ;address of data to load
  3300. ifdef LONGPTR
  3301.     call    $dldpss
  3302. else
  3303.     call    $dldp
  3304. endif
  3305.     ret    8        ;return and de-allocate space
  3306. ;
  3307.     intrdef $dpop        ;pop double float into secondary accum
  3308.     mov    bx,sp
  3309.     add    bx,frame    ;address of data to load
  3310. ifdef LONGPTR
  3311.     call    $dldsss
  3312. else
  3313.     call    $dlds
  3314. endif
  3315.     ret    8        ;return and de-allocate space
  3316. ;
  3317.     intrdef $dswap        ;exchange primary and secondary
  3318.     wait
  3319.     esc    40,second    ;fld    qword ptr second
  3320.     wait
  3321.     db    0d9h,0c9h    ;fxch
  3322.     wait
  3323.     esc    43,second    ;fstp    qword ptr second
  3324.     ret
  3325. ;
  3326.     intrdef $dng        ;negate primary
  3327.     wait
  3328.     db    0d9h,0e0h    ;fchs
  3329.     ret
  3330. ;
  3331.     intrdef $dtst        ;test if primary is zero
  3332.     wait
  3333.     db    0d9h,0e4h    ;ftst
  3334.     wait
  3335.     esc    47,status    ;fstsw    status
  3336.     wait
  3337.     mov    ah,byte ptr status+1
  3338.     sahf
  3339.     jne    ltrue
  3340.     sub    ax,ax
  3341.     ret
  3342. ltrue:
  3343.     sub    ax,ax
  3344.     inc    ax
  3345.     ret
  3346. ;
  3347.     intrdef $dcmp        ;compare primary and secondary
  3348.     wait
  3349.     esc    34,second    ;fcom    qword ptr second
  3350.     wait
  3351.     esc    47,status    ;fstsw    status
  3352.     wait
  3353.     mov    ah,byte ptr status+1
  3354.     sahf
  3355.     jb    lp_lt_s
  3356.     ja    lp_gt_s
  3357.             ;return 0 if p == s
  3358.     xor    ax,ax
  3359.     ret
  3360.             ;return 0 if p == s
  3361. lp_lt_s:            ;return < 0 if p < s
  3362.     xor    ax,ax
  3363.     dec    ax
  3364.     ret
  3365. ;
  3366. lp_gt_s:            ;    > 0 if p > s
  3367.     xor    ax,ax
  3368.     inc    ax
  3369.     ret
  3370. ;
  3371.     intrdef $dsb        ;subtract secondary from primary
  3372.     wait
  3373.     esc    36,second    ;fsub    qword ptr second
  3374.     ret
  3375. ;
  3376.     intrdef $dad        ;add secondary to primary
  3377.     wait
  3378.     esc    32,second    ;fadd    qword ptr second
  3379.     ret
  3380. ;
  3381.     intrdef $ddv
  3382.         ;double floating divide    (primary = primary/secondary)
  3383.     wait
  3384.     esc    38,second    ;fdiv    qword ptr second
  3385.     ret
  3386. ;
  3387.     intrdef $dml
  3388.         ;double floating multiply    (primary = primary * secondary)
  3389.     wait
  3390.     esc    33,second    ;fmul    qword ptr second
  3391.     ret
  3392. ;
  3393.     intrdef $utod
  3394.     wait
  3395.     db    0dbh,0e3h    ;finit
  3396.     mov    work,ax
  3397.     mov    work+2,0
  3398.     wait
  3399.     esc    24,work    ;fild    dword ptr work
  3400.     ret
  3401. ;
  3402.     intrdef $itod
  3403.     wait
  3404.     db    0dbh,0e3h    ;finit
  3405.     mov    work,ax
  3406.     wait
  3407.     esc    56,work    ;fild    word ptr work
  3408.     ret
  3409. ;
  3410.     intrdef $xtod
  3411.     wait
  3412.     db    0dbh,0e3h    ;finit
  3413.     mov    work,ax
  3414.     mov    work+2,dx
  3415.     wait
  3416.     esc    24,work    ;fild    dword ptr work
  3417.     ret
  3418. ;
  3419.     intrdef $dtou
  3420.     intrdef $dtoi
  3421.     intrdef $dtox
  3422.     wait
  3423.     esc    13,chop_ctl    ;fldcw    chop_ctl
  3424.     wait
  3425.     esc    26,work    ;fist    dword ptr work
  3426.     wait
  3427.     esc    13,round_ctl    ;fldcw    round_ctl
  3428.     mov    ax,work
  3429.     mov    dx,work+2
  3430.     ret
  3431. ifndef INTERNAL
  3432. $floats    endp
  3433.     finish
  3434.     end
  3435. endif
  3436. frexp87s.asm
  3437. ;    Copyright (C) 1983 by Manx Software Systems
  3438. ; :ts=8
  3439. ;    the psuedo accumlators are formated as follows:
  3440. ;    -10    -8    -6    -4    -2    0
  3441. ;    |grd + LS ----- fraction ---- MS |  exp | sign
  3442. ;
  3443. ;    floating point system error codes:
  3444. UNDER_FLOW    equ    1
  3445. OVER_FLOW    equ    2
  3446. DIV_BY_ZERO    equ    3
  3447. ;
  3448.     include    lmacros.h
  3449. dataseg    segment word public 'data'
  3450.     dw    5 dup (?)
  3451. temp    dw    ?
  3452.     extrn    flprm:word,flsec:word
  3453.     extrn    flterr_:word
  3454. status    dw    ?
  3455.     extrn    $flt_inx:word,chop_ctl:word, round_ctl:word
  3456. dataseg    ends
  3457.     assume    ds:dataseg
  3458.  
  3459. ifdef FARPROC
  3460.     extrn    $dldp:far, $dst:far, $itod:far
  3461.     extrn    $dad:far, $dsb:far, $isnan:far
  3462. else
  3463.     extrn    $dldp:near, $dst:near, $itod:near
  3464.     extrn    $dad:near, $dsb:near, $isnan:near
  3465. endif
  3466.     procdef isnan,<<ddd,cdouble>>
  3467. ifdef LONGPTR
  3468.     mov    bx,ss
  3469.     mov    es,bx
  3470. endif
  3471.     lea    bx,ddd        ;compute address of first argument
  3472.     call    $dldp        ;load it into the float primary
  3473.     call    $isnan
  3474.     pret
  3475.     pend    isnan
  3476.  
  3477.     procdef    frexp, <<d,cdouble>,<i,ptr>>
  3478. ;
  3479. ;        frexp(d, &i)
  3480. ;            returns 0 <= x < 1
  3481. ;            such that: d = x * 2^i
  3482. ifdef LONGPTR
  3483.     mov    bx,ss
  3484.     mov    es,bx
  3485. endif
  3486.     lea    bx,d        ;compute address of first argument
  3487.     call    $dldp        ;load it into the float primary
  3488.     mov    cx,$flt_inx
  3489.     or    cx,cx
  3490.     jnz    $frexp87
  3491.     mov    bx,flprm
  3492.     mov    ax,word ptr -2[bx]    ;fetch current exponent value
  3493.     test    ax,ax
  3494.     jnz    fr_nzero
  3495.     ldptr    bx,i,es        ;get pointer
  3496. ifdef LONGPTR
  3497.     mov    es:word ptr [bx],0
  3498. else
  3499.     mov    ds:word ptr [bx],0
  3500. endif
  3501.     pret
  3502. fr_nzero:
  3503.     sub    ax,1022
  3504.     mov    word ptr -2[bx],1022
  3505.     ldptr    bx,i,es        ;get pointer
  3506. ifdef LONGPTR
  3507.     mov    es:word ptr [bx],ax
  3508. else
  3509.     mov    ds:word ptr [bx],ax
  3510. endif
  3511.     pret
  3512. $frexp87:
  3513.     wait
  3514.     db    0dbh,0e3h    ;finit
  3515.     wait
  3516.     db    0d9h,0e8h    ;fld1
  3517.     wait
  3518.     db    0d9h,0e0h    ;fchs
  3519.     wait
  3520.     esc    40,d        ;fld qword ptr 4[bp]
  3521.     wait
  3522.     db    0d9h,0e4h    ;ftst
  3523.     wait
  3524.     esc    47,status    ;fstsw exponent
  3525.     mov    ah,byte ptr status+1
  3526.     sahf
  3527.     je    zero
  3528.     wait
  3529.     db    0d9h,0f4h    ;fxtract
  3530.     wait
  3531.     db    0d9h,0c9h    ;fxch
  3532.     wait
  3533.     db    0d8h,0e2h    ;fsub    st,st(2)
  3534.     ldptr    bx,i,es
  3535.     wait
  3536. ifdef LONGPTR
  3537.     esc    59,es:[bx]    ;fistp word ptr [bx]
  3538. else
  3539.     esc    59,ds:[bx]    ;fistp word ptr [bx]
  3540. endif
  3541.     wait
  3542.     db    0d9h,0fdh    ;fscale
  3543.     pret
  3544. zero:
  3545.     ldptr    bx,i,es
  3546. ifdef LONGPTR
  3547.     mov    es:word ptr [bx],0
  3548. else
  3549.     mov    ds:word ptr [bx],0
  3550. endif
  3551.     pret
  3552.     pend    frexp
  3553. ;
  3554. ;    ldexp(d, i)
  3555. ;        returns x = d * 2^i
  3556.     procdef    ldexp, <<dou,cdouble>,<ii,word>>
  3557. ifdef LONGPTR
  3558.     mov    bx,ss
  3559.     mov    es,bx
  3560. endif
  3561.     lea    bx,dou        ;compute address of first argument
  3562.     call    $dldp        ;load it into the float primary
  3563.     mov    cx,$flt_inx
  3564.     or    cx,cx
  3565.     jnz    $ldexp87
  3566.     mov    bx,flprm
  3567.     mov    ax,word ptr -2[bx]    ;fetch current exponent value
  3568.     test    ax,ax
  3569.     jz    ld_zero
  3570.     add    ax,ii            ;add i to exponent
  3571.     js    ld_underflow
  3572.     cmp    ax,2048
  3573.     jl    ld_ret
  3574.     mov    flterr_,UNDER_FLOW
  3575.     mov    ax,2047
  3576. ld_ret:
  3577.     mov    word ptr -2[bx],ax
  3578. ld_zero:
  3579.     pret
  3580. ;
  3581. ld_underflow:
  3582.     mov    flterr_,UNDER_FLOW
  3583.     sub    ax,ax
  3584.     jmp    ld_ret
  3585. $ldexp87:
  3586.     wait
  3587.     db    0dbh,0e3h    ;finit
  3588.     wait
  3589.     esc    56,ii        ;fild word ptr 12[bp]
  3590.     wait
  3591.     esc    40,dou        ;fld qword ptr 4[bp]
  3592.     wait
  3593.     db    0d9h,0fdh    ;fscale
  3594.     pret
  3595.     pend    ldexp
  3596. ;
  3597. ;    modf(d, dptr)
  3598. ;        returns fractional part of d, and
  3599. ;        stores integral part into *dptr
  3600.     procdef    modf,<<doubl,cdouble>,<dptr,ptr>>
  3601.     push    di
  3602.     push    si
  3603.     pushds
  3604. ifdef LONGPTR
  3605.     mov    bx,ss
  3606.     mov    es,bx
  3607. endif
  3608.     lea    bx,doubl    ;compute address of first argument
  3609.     call    $dldp        ;load it into the float primary
  3610.     mov    cx,$flt_inx
  3611.     or    cx,cx
  3612.     jz    around
  3613.     jmp    $modf87
  3614. around:
  3615.     std
  3616.     mov    bx,flprm
  3617.     mov    ax,word ptr -2[bx]    ;fetch current exponent value
  3618.     test    ax,ax
  3619.     jnz    mf_nzero
  3620.     ldptr    bx,dptr,es    ;get pointer
  3621.     call    $dst
  3622. mf_return:
  3623.     cld
  3624.     popds
  3625.     pop    si
  3626.     pop    di
  3627.     pret
  3628. mf_nzero:
  3629.     mov    di,ds
  3630.     mov    es,di
  3631.     mov    si,bx
  3632.     mov    di,offset temp
  3633.     mov    cx,6        ;save value for fraction part later
  3634. rep    movsw
  3635.     sub    ax,1023
  3636.     jns    int_notzero
  3637.     mov    ax,0
  3638.     call    $itod
  3639.     jmp    get_fraction
  3640. int_notzero:
  3641.     cmp    ax,52
  3642.     jna    mf_frac
  3643.                 ;fraction is zero
  3644.     ldptr    bx,dptr,es    ;get pointer
  3645.     call    $dst        ;store integer part away
  3646.     sub    ax,ax
  3647.     call    $itod
  3648.     jmp    mf_return
  3649. mf_frac:
  3650.     sub    di,di
  3651.     mov    cx,ax
  3652.     mov    ax,4
  3653. mf_count:
  3654.     sub    cx,ax
  3655.     jbe    mf_cdone
  3656.     dec    di
  3657.     mov    ax,8
  3658.     jmp    mf_count
  3659. mf_cdone:
  3660.     jcxz    no_shift
  3661.     neg    cx
  3662.     mov    al,byte ptr -3[bx][di]
  3663.     shr    al,cl
  3664.     shl    al,cl
  3665.     mov    byte ptr -3[bx][di],al
  3666. no_shift:
  3667.     dec    di
  3668. zap_loop:
  3669.     cmp    di,-8
  3670.     jle    get_fraction
  3671.     mov    byte ptr -3[bx][di],0
  3672.     dec    di
  3673.     jmp    zap_loop
  3674. get_fraction:
  3675.     ldptr    bx,dptr,es    ;get pointer
  3676.     call    $dst        ;store integer part away
  3677.     std
  3678.     popds
  3679.     pushds
  3680.     mov    di,flprm
  3681.     xchg    di,flsec
  3682.     mov    flprm,di
  3683.     mov    si,ds
  3684.     mov    es,si
  3685.     mov    si,offset temp
  3686.     mov    cx,6        ;restore original value
  3687. rep    movsw
  3688.     call    $dsb        ;compute fractional part
  3689.     jmp    mf_return
  3690. $modf87:
  3691.     wait
  3692.     db    0dbh,0e3h    ;finit
  3693.     wait
  3694.     esc    40,doubl    ;fld qword ptr 4[bp]
  3695.     wait
  3696.     db    0d9h,0c0h    ;fld st(0)
  3697.     wait
  3698.     esc    13,chop_ctl    ;fldcw    chop_ctl
  3699.     wait
  3700.     db    0d9h,0fch    ;frndint
  3701.     ldptr    bx,dptr,es
  3702.     wait
  3703.     esc    13,round_ctl    ;fldcw    round_ctl
  3704.     wait
  3705. ifdef LONGPTR
  3706.     esc    42,es:[bx]    ;fst qword ptr [bx]
  3707. else
  3708.     esc    42,ds:[bx]    ;fst qword ptr [bx]
  3709. endif
  3710.     wait
  3711.     db    0deh,0e9h    ;fsub
  3712.     popds
  3713.     pop    si
  3714.     pop    di
  3715.     pret
  3716.     pend    modf
  3717.     finish
  3718.     end
  3719. sqrt87s.asm
  3720.     include lmacros.h
  3721. dataseg segment para public 'data'
  3722. status    dw    ?
  3723.     extrn    chop_ctl:word, round_ctl:word
  3724.     extrn    errno_:word
  3725.     extrn    $flt_inx:word
  3726. dataseg ends
  3727.     assume    ds:dataseg
  3728. ;#include "math.h"
  3729. ;#include "errno.h"
  3730. ifdef FARPROC
  3731. OFFS equ    2
  3732. else
  3733. OFFS equ    0
  3734. endif
  3735. ;
  3736. ifndef LONGPTR
  3737. $dldsss equ $dlds
  3738. $dldpss equ $dldp
  3739. $dstss  equ $dst
  3740. $dldsds equ $dlds
  3741. $dldpds equ $dldp
  3742. $dstds  equ $dst
  3743. $fldsss equ $flds
  3744. $fldpss equ $fldp
  3745. $fstss  equ $fst
  3746. $fldsds equ $flds
  3747. $fldpds equ $fldp
  3748. $fstds  equ $fst
  3749. endif
  3750. ;double sqrt(x)
  3751. ;double x;
  3752.     procdef sqrt, <<doub,cdouble>>
  3753.     lea    bx,doub
  3754.     call $dldpss
  3755.     mov    cx,$flt_inx
  3756.     or    cx,cx
  3757.     jz    $sqrt86
  3758. ;
  3759. ;
  3760.  
  3761. ERANGE    equ    -20
  3762. EDOM    equ    -21
  3763.  
  3764. $sqrt87:
  3765.     wait
  3766.     db    0dbh,0e3h    ;finit
  3767.     wait
  3768.     esc    40,ss:4+OFFS[bp]    ;fld qword ptr 4+OFFS[bp]
  3769.     wait
  3770.     db    0d9h,0e4h    ;ftst
  3771.     wait
  3772.     esc    47,status    ;fstsw exponent
  3773.     mov    ah,byte ptr status+1
  3774.     sahf
  3775.     jnb    sqrt_ok
  3776.     wait
  3777.     db    0d9h,0e0h    ;fchs
  3778.     mov    errno_,EDOM
  3779.     wait
  3780. sqrt_ok:
  3781.     db    0d9h,0fah    ;fsqrt
  3782.     pret    sqrt
  3783. ;
  3784. $sqrt86:
  3785. ;
  3786. ;{
  3787. ;    double f, y;
  3788. ;    int n;
  3789. ;    extern int errno;
  3790.     add sp,$2
  3791.     push    di
  3792.     push    si
  3793. ;    
  3794. ;    if (x == 0.0)
  3795. ;        return x;
  3796.     call    $dlis
  3797.     db 00H,00H,00H,00H,00H,00H,00H,00H
  3798.     call    $dcmp
  3799.     jne     $3
  3800.     lea    bx,doub
  3801.     call    $dldpss
  3802.     jmp    $cret
  3803. ;    if (x < 0.0) {
  3804. $3:
  3805.     lea    bx,doub
  3806.     call    $dldpss
  3807.     call    $dlis
  3808.     db 00H,00H,00H,00H,00H,00H,00H,00H
  3809.     call    $dcmp
  3810.     jge     $4
  3811. ;        errno = EDOM;
  3812.     mov     word ptr errno_,22
  3813. ;        return 0.0;
  3814.     call    $dlip
  3815.     db 00H,00H,00H,00H,00H,00H,00H,00H
  3816.  
  3817.     jmp    $cret
  3818. ;    }
  3819. ;    f = frexp(x, &n);
  3820. $4:
  3821.     lea    ax,word ptr -18[bp]
  3822. ifdef LONGPTR
  3823.     push    ss
  3824. endif
  3825.     push    ax
  3826.     lea    bx,doub
  3827.     call    $dldpss
  3828.     call    $dpsh
  3829.     call    frexp_
  3830. ifdef LONGPTR
  3831.     add    sp,12
  3832. else
  3833.     add sp,10
  3834. endif
  3835.     lea    bx,word ptr -8[bp]
  3836.     call    $dstss
  3837. ;    y = 0.41731 + 0.59016 * f;
  3838.     lea    bx,word ptr -8[bp]
  3839.     call    $dldpss
  3840.     call    $dlis
  3841.     db 018H,09H,06dH,039H,097H,0e2H,0e2H,03fH
  3842.     call    $dml
  3843.     call    $dlis
  3844.     db 0f7H,0ccH,092H,00H,035H,0b5H,0daH,03fH
  3845.     call    $dad
  3846.     lea    bx,word ptr -16[bp]
  3847.     call    $dstss
  3848. ;    y = (y + f/y);
  3849.     lea    bx,word ptr -8[bp]
  3850.     call    $dldpss
  3851.     lea    bx,word ptr -16[bp]
  3852.     call    $dldsss
  3853.     call    $ddv
  3854.     lea    bx,word ptr -16[bp]
  3855.     call    $dldsss
  3856.     call    $dad
  3857.     lea    bx,word ptr -16[bp]
  3858.     call    $dstss
  3859. ;    y = ldexp(y,-2) + f/y;    /* fast calculation of y2 */
  3860.     mov    ax,-2
  3861.     push    ax
  3862.     lea    bx,word ptr -16[bp]
  3863.     call    $dldpss
  3864.     call    $dpsh
  3865.     call    ldexp_
  3866.     add sp,10
  3867.     call    $dpsh
  3868.     lea    bx,word ptr -8[bp]
  3869.     call    $dldpss
  3870.     lea    bx,word ptr -16[bp]
  3871.     call    $dldsss
  3872.     call    $ddv
  3873.     call    $dpop
  3874.     call    $dad
  3875.     lea    bx,word ptr -16[bp]
  3876.     call    $dstss
  3877. ;    y = ldexp(y + f/y, -1);
  3878.     mov    ax,-1
  3879.     push    ax
  3880.     lea    bx,word ptr -8[bp]
  3881.     call    $dldpss
  3882.     lea    bx,word ptr -16[bp]
  3883.     call    $dldsss
  3884.     call    $ddv
  3885.     lea    bx,word ptr -16[bp]
  3886.     call    $dldsss
  3887.     call    $dad
  3888.     call    $dpsh
  3889.     call    ldexp_
  3890.     add sp,10
  3891.     lea    bx,word ptr -16[bp]
  3892.     call    $dstss
  3893. ;    y = ldexp(y + f/y, -1);
  3894.     mov    ax,-1
  3895.     push    ax
  3896.     lea    bx,word ptr -8[bp]
  3897.     call    $dldpss
  3898.     lea    bx,word ptr -16[bp]
  3899.     call    $dldsss
  3900.     call    $ddv
  3901.     lea    bx,word ptr -16[bp]
  3902.     call    $dldsss
  3903.     call    $dad
  3904.     call    $dpsh
  3905.     call    ldexp_
  3906.     add sp,10
  3907.     lea    bx,word ptr -16[bp]
  3908.     call    $dstss
  3909. ;    
  3910. ;    if (n&1) {
  3911.     mov    ax,word ptr -18[bp]
  3912.     test    ax,1
  3913.     jeq     $5
  3914. ;        y *= 0.70710678118654752440;
  3915.     lea    bx,word ptr -16[bp]
  3916.     call    $dldpss
  3917.     call    $dlis
  3918.     db 0cdH,03bH,07fH,066H,09eH,0a0H,0e6H,03fH
  3919.     call    $dml
  3920.     lea    bx,word ptr -16[bp]
  3921.     call    $dstss
  3922. ;        ++n;
  3923.     inc    word ptr -18[bp]
  3924. ;    }
  3925. ;    return ldexp(y,n/2);
  3926. $5:
  3927.     mov    ax,word ptr -18[bp]
  3928.     mov    cx,2
  3929.     cwd
  3930.     idiv    cx
  3931.     push    ax
  3932.     lea    bx,word ptr -16[bp]
  3933.     call    $dldpss
  3934.     call    $dpsh
  3935.     call    ldexp_
  3936.     add sp,10
  3937.     jmp    $cret
  3938.  
  3939. $cret:
  3940.     pop    si
  3941.     pop    di
  3942.     mov    sp,bp
  3943.     pop    bp
  3944.     ret
  3945. ;}
  3946. $2 = -18
  3947. ;
  3948. ifdef FARPROC
  3949.     extrn    frexp_:far
  3950.     extrn    ldexp_:far
  3951.     extrn $dad:far,$dsb:far,$dml:far,$ddv:far
  3952.     extrn $dldp:far,$dlds:far,$dlip:far,$dlis:far,$dst:far
  3953.     extrn $fldp:far,$flds:far,$fst:far,$dcmp:far,$dtst:far
  3954.     extrn $dpsh:far,$dpopp:far,$dpop:far,$dng:far,$dswap:far
  3955.     extrn $itod:far,$utod:far,$xtod:far
  3956.     extrn $dtoi:far,$dtou:far,$dtox:far
  3957. else
  3958.     extrn    frexp_:near
  3959.     extrn    ldexp_:near
  3960.     extrn $dad:near,$dsb:near,$dml:near,$ddv:near
  3961.     extrn $dldp:near,$dlds:near,$dlip:near,$dlis:near,$dst:near
  3962.     extrn $fldp:near,$flds:near,$fst:near,$dcmp:near,$dtst:near
  3963.     extrn $dpsh:near,$dpopp:near,$dpop:near,$dng:near,$dswap:near
  3964.     extrn $itod:near,$utod:near,$xtod:near
  3965.     extrn $dtoi:near,$dtou:near,$dtox:near
  3966. endif
  3967. ifdef LONGPTR
  3968. ifdef FARPROC
  3969.     extrn $dldpss:far,$dldsss:far,$dstss:far
  3970.     extrn $dldpds:far,$dldsds:far,$dstds:far
  3971.     extrn $fldpss:far,$fldsss:far,$fstss:far
  3972.     extrn $fldpds:far,$fldsds:far,$fstds:far
  3973. else
  3974.     extrn $dldpss:near,$dldsss:near,$dstss:near
  3975.     extrn $dldpds:near,$dldsds:near,$dstds:near
  3976.     extrn $fldpss:near,$fldsss:near,$fstss:near
  3977.     extrn $fldpds:near,$fldsds:near,$fstds:near
  3978. endif
  3979. endif
  3980.     pend    sqrt
  3981. dataseg segment para public 'data'
  3982.     extrn    errno_:word
  3983. dataseg ends
  3984.     end
  3985. fsubs87s.asm
  3986. ;    Copyright (C) 1983 by Manx Software Systems
  3987. ;    page    54,130
  3988. ; :ts=8
  3989. ;    floating point system error codes:
  3990.     include    lmacros.h
  3991.  
  3992.     internal $floats
  3993.  
  3994. UNDER_FLOW    equ    1
  3995. OVER_FLOW    equ    2
  3996. DIV_BY_ZERO    equ    3
  3997. ;
  3998. codeseg    segment    para public 'code'
  3999.     public    flprm,flsec
  4000.     public    flterr_
  4001. dataseg    segment para public 'data'
  4002. second    db    8 dup (?)
  4003. work    dw    4 dup (?)
  4004. status    dw    0
  4005.     public    $flt_inx, chop_ctl, round_ctl, rdown_ctl
  4006. $flt_inx dw    0        ; 8087/software emulation switch index
  4007. chop_ctl dw    0fbfH        ;control word for Chop mode
  4008. round_ctl dw    03bfH        ;control word for Round nearest mode
  4009. rdown_ctl dw    07bfh        ;control word for Round Down mode
  4010.  
  4011. flterr_    dw    0
  4012. flprm    dw    acc1
  4013. flsec    dw    acc2
  4014. YU    dw    ?
  4015. VEE    dw    ?
  4016.     dw    4 dup (?)
  4017. acc1    dw    6 dup (?)
  4018. acc2    dw    ?
  4019. ;
  4020. ;work area for divide and multiply routines
  4021. ;
  4022.     dw    ?
  4023. temp    dw    4 dup (?)
  4024. loop_count    db    0    ;iterations left (for divide)
  4025. lcnt1    db    0        ;# iter. for this word of quotient
  4026. dataseg    ends
  4027.  
  4028. ifdef LONGPTR
  4029.     assume    ds:dataseg
  4030. else
  4031.     assume    ds:dataseg,es:dataseg,ss:dataseg
  4032. endif
  4033.  
  4034. ifdef FARPROC
  4035. frame    equ    4
  4036. CALLSZ    equ    5
  4037. else
  4038. frame    equ    2
  4039. CALLSZ    equ    3
  4040. endif
  4041.  
  4042. dataseg    segment para public 'data'
  4043. $flttb86:            ; 8086 software indirection table
  4044.     dw    $isnan86
  4045.     dw    $flds86
  4046.     dw    $fldp86
  4047.     dw    $fst86
  4048.     dw    $fsts86
  4049.     dw    $dlis86
  4050.     dw    $dlds86
  4051.     dw    $dlip86
  4052.     dw    $dldp86
  4053.     dw    $dst86
  4054.     dw    $dsts86
  4055.     dw    $dpsh86
  4056.     dw    $dpshs86
  4057.     dw    $dpop86
  4058.     dw    $dpopp86
  4059.     dw    $dswap86
  4060.     dw    $dng86
  4061.     dw    $dtst86
  4062.     dw    $dcmp86
  4063.     dw    $dsb86
  4064.     dw    $dad86
  4065.     dw    $ddv86
  4066.     dw    $dml86
  4067.     dw    $utod86
  4068.     dw    $itod86
  4069.     dw    $xtod86
  4070.     dw    $dtoi86
  4071. ifdef LONGPTR
  4072.     dw    $fldsss86
  4073.     dw    $fldsds86
  4074.     dw    $fldpss86
  4075.     dw    $fldpds86
  4076.     dw    $fstss86
  4077.     dw    $fstds86
  4078.     dw    $fstsss86
  4079.     dw    $fstsds86
  4080.     dw    $dldsss86
  4081.     dw    $dldsds86
  4082.     dw    $dldpss86
  4083.     dw    $dldpds86
  4084.     dw    $dstss86
  4085.     dw    $dstds86
  4086.     dw    $dstsss86
  4087.     dw    $dstsds86
  4088. endif
  4089.  
  4090. $flttb87:                ; 8087 hardware indirection table
  4091.     dw    $isnan87
  4092.     dw    $flds87
  4093.     dw    $fldp87
  4094.     dw    $fst87
  4095.     dw    $fsts87
  4096.     dw    $dlis87
  4097.     dw    $dlds87
  4098.     dw    $dlip87
  4099.     dw    $dldp87
  4100.     dw    $dst87
  4101.     dw    $dsts87
  4102.     dw    $dpsh87
  4103.     dw    $dpshs87
  4104.     dw    $dpop87
  4105.     dw    $dpopp87
  4106.     dw    $dswap87
  4107.     dw    $dng87
  4108.     dw    $dtst87
  4109.     dw    $dcmp87
  4110.     dw    $dsb87
  4111.     dw    $dad87
  4112.     dw    $ddv87
  4113.     dw    $dml87
  4114.     dw    $utod87
  4115.     dw    $itod87
  4116.     dw    $xtod87
  4117.     dw    $dtoi87
  4118. ifdef LONGPTR
  4119.     dw    $fldsss87
  4120.     dw    $fldsds87
  4121.     dw    $fldpss87
  4122.     dw    $fldpds87
  4123.     dw    $fstss87
  4124.     dw    $fstds87
  4125.     dw    $fstsss87
  4126.     dw    $fstsds87
  4127.     dw    $dldsss87
  4128.     dw    $dldsds87
  4129.     dw    $dldpss87
  4130.     dw    $dldpds87
  4131.     dw    $dstss87
  4132.     dw    $dstds87
  4133.     dw    $dstsss87
  4134.     dw    $dstsds87
  4135. endif
  4136. dataseg    ends
  4137.  
  4138.  
  4139. $flttb:                ; initial indirection table
  4140. $isnantb     dw    $flt_tst
  4141. $fldstb      dw    $flt_tst
  4142. $fldptb     dw    $flt_tst
  4143. $fsttb        dw    $flt_tst
  4144. $fststb        dw    $flt_tst
  4145. $dlistb     dw    $flt_tst
  4146. $dldstb     dw    $flt_tst
  4147. $dliptb     dw    $flt_tst
  4148. $dldptb     dw    $flt_tst
  4149. $dsttb        dw    $flt_tst
  4150. $dststb        dw    $flt_tst
  4151. $dpshtb     dw    $flt_tst
  4152. $dpshstb    dw    $flt_tst
  4153. $dpoptb     dw    $flt_tst
  4154. $dpopptb     dw    $flt_tst
  4155. $dswaptb     dw    $flt_tst
  4156. $dngtb        dw    $flt_tst
  4157. $dtsttb     dw    $flt_tst
  4158. $dcmptb     dw    $flt_tst
  4159. $dsbtb        dw    $flt_tst
  4160. $dadtb        dw    $flt_tst
  4161. $ddvtb        dw    $flt_tst
  4162. $dmltb        dw    $flt_tst
  4163. $utodtb     dw    $flt_tst
  4164. $itodtb     dw    $flt_tst
  4165. $xtodtb     dw    $flt_tst
  4166. $dtoitb     dw    $flt_tst
  4167. ifdef LONGPTR
  4168. $fldssstb    dw    $flt_tst
  4169. $fldsdstb    dw    $flt_tst
  4170. $fldpsstb    dw    $flt_tst
  4171. $fldpdstb    dw    $flt_tst
  4172. $fstsstb    dw    $flt_tst
  4173. $fstdstb    dw    $flt_tst
  4174. $fstssstb    dw    $flt_tst
  4175. $fstsdstb    dw    $flt_tst
  4176. $dldssstb    dw    $flt_tst
  4177. $dldsdstb    dw    $flt_tst
  4178. $dldpsstb    dw    $flt_tst
  4179. $dldpdstb    dw    $flt_tst
  4180. $dstsstb    dw    $flt_tst
  4181. $dstdstb    dw    $flt_tst
  4182. $dstssstb    dw    $flt_tst
  4183. $dstsdstb    dw    $flt_tst
  4184. endif
  4185.  
  4186.  
  4187. ifdef LONGPTR
  4188. SIZFLTTB equ 43
  4189. else
  4190. SIZFLTTB equ 27
  4191. endif
  4192.  
  4193. $flt_tst:
  4194. ;    test for 8087 goes here
  4195.     push    si
  4196.     push    di
  4197.     push    es
  4198.     mov    ds:status,0
  4199.     esc    28,bx            ;    finit (initialize 8087)
  4200.     xor    cx,cx
  4201.     esc    15,ds:status        ;    fstcw
  4202.     mov    cx,50
  4203. w1loop:    loop    w1loop            ; wait for a while
  4204.     and    status,01f3fh        ; clear unused bits
  4205.     cmp    status,0033fh        ; is 8087 there?
  4206.     mov    si,offset $flttb86    ; assume not
  4207.     mov    cx,0
  4208.     jnz    $fltnxt            ; no, use software emulation
  4209.     wait
  4210.     esc    47,status        ;    fstsw    status
  4211.     mov    cx,50
  4212. w2loop:    loop    w2loop            ; wait for a while
  4213.     test    ds:status,0b8bfh    ; all status bits should be off
  4214.     mov    si,offset $flttb86    ; assume not
  4215.     mov    cx,0
  4216.     jnz    $fltnxt            ; bad status, assume not there
  4217.     mov    si,offset $flttb87    ; 8087 is there!
  4218.     mov    cx,2
  4219. $fltnxt:
  4220.     mov    $flt_inx,cx        ; set index for outside routines
  4221.     mov    di,cs
  4222.     mov    es,di
  4223.     mov    di,cs:offset $flttb    ; get pointer to indirection table
  4224.     mov    cx,SIZFLTTB
  4225.     cld
  4226. rep    movsw                ; and overwrite it with new table
  4227.     pop    es
  4228.     pop    di
  4229.     pop    si
  4230.     pop    cx            ; get return address offset part
  4231.     sub    cx,CALLSZ        ; back up return over call
  4232.     push    cx            ; put back on stack
  4233.     ret                ; and return to reissue call
  4234.  
  4235.     intrdef $isnan
  4236.     jmp    cs:word    ptr $isnantb
  4237.  
  4238.     intrdef $flds        ;load single float into secondary accum
  4239.     jmp    cs:word    ptr $fldstb
  4240.  
  4241. ifdef LONGPTR
  4242.     intrdef $fldsss        ;load single float into secondary accum
  4243.     jmp    cs:word    ptr $fldssstb
  4244.  
  4245.     intrdef $fldsds        ;load single float into secondary accum
  4246.     jmp    cs:word    ptr $fldsdstb
  4247. endif
  4248. ;
  4249.     intrdef $fldp        ;load single float into primary accum
  4250.     jmp    cs:word    ptr $fldptb
  4251. ;
  4252. ifdef LONGPTR
  4253.     intrdef $fldpss        ;load single float into primary accum
  4254.     jmp    cs:word    ptr $fldpsstb
  4255. ;
  4256.     intrdef $fldpds        ;load single float into primary accum
  4257.     jmp    cs:word    ptr $fldpdstb
  4258. endif
  4259. ;
  4260.     intrdef $fst        ;store single at addr in BX
  4261.     jmp    cs:word    ptr $fsttb
  4262. ;
  4263.     intrdef $fsts        ;store single at addr in BX
  4264.     jmp    cs:word    ptr $fststb
  4265. ;
  4266. ifdef LONGPTR
  4267.     intrdef $fstss        ;store single at addr in BX
  4268.     jmp    cs:word    ptr $fstsstb
  4269. ;
  4270.     intrdef $fstds        ;store single at addr in BX
  4271.     jmp    cs:word    ptr $fstdstb
  4272.  
  4273.     intrdef $fstsss        ;store single at addr in BX
  4274.     jmp    cs:word    ptr $fstssstb
  4275. ;
  4276.     intrdef $fstsds        ;store single at addr in BX
  4277.     jmp    cs:word    ptr $fstsdstb
  4278. endif
  4279. ;
  4280.     intrdef $dlis        ;load double immediate secondary
  4281.     jmp    cs:word    ptr $dlistb
  4282. ;
  4283. ifdef LONGPTR
  4284.     intrdef $dldsss
  4285.     jmp    cs:word    ptr $dldssstb
  4286.  
  4287.     intrdef $dldsds
  4288.     jmp    cs:word    ptr $dldsdstb
  4289. endif
  4290.     intrdef $dlds        ;load double float into secondary accum
  4291.     jmp    cs:word    ptr $dldstb
  4292. ;
  4293.     intrdef $dlip        ;load double immediate primary
  4294.     jmp    cs:word    ptr $dliptb
  4295. ;
  4296. ifdef LONGPTR
  4297.     intrdef $dldpss        ;load double float into primary accum
  4298.     jmp    cs:word    ptr $dldpsstb
  4299.  
  4300.     intrdef $dldpds        ;load double float into primary accum
  4301.     jmp    cs:word    ptr $dldpdstb
  4302. endif
  4303.     intrdef $dldp        ;load double float into primary accum
  4304.     jmp    cs:word    ptr $dldptb
  4305. ;
  4306.     intrdef $dsts
  4307.     jmp    cs:word    ptr $dststb
  4308.  
  4309.     intrdef $dst        ;store double at addr in BX
  4310.     jmp    cs:word    ptr $dsttb
  4311. ifdef LONGPTR
  4312.     intrdef $dstss        ;store double at addr in BX
  4313.     jmp    cs:word    ptr $dstsstb
  4314.  
  4315.     intrdef $dstds        ;store double at addr in BX
  4316.     jmp    cs:word    ptr $dstdstb
  4317.  
  4318.     intrdef $dstsss        ;store double at addr in BX
  4319.     jmp    cs:word    ptr $dstssstb
  4320.  
  4321.     intrdef $dstsds        ;store double at addr in BX
  4322.     jmp    cs:word    ptr $dstsdstb
  4323. endif
  4324. ;
  4325.     intrdef $dpsh        ;push double float onto the stack
  4326.                 ;from the primary accumulator
  4327.     jmp    cs:word    ptr $dpshtb
  4328. ;
  4329.     intrdef $dpshs        ;push double float onto the stack
  4330.                 ;from the secondary accumulator
  4331.     jmp    cs:word    ptr $dpshstb
  4332.  
  4333.     intrdef $dpopp        ;pop double float into primary accum
  4334.     jmp    cs:word    ptr $dpopptb
  4335. ;
  4336.     intrdef $dpop        ;pop double float into secondary accum
  4337.     jmp    cs:word    ptr $dpoptb
  4338. ;
  4339.     intrdef $dswap        ;exchange primary and secondary
  4340.     jmp    cs:word    ptr $dswaptb
  4341. ;
  4342.     intrdef $dng        ;negate primary
  4343.     jmp    cs:word    ptr $dngtb
  4344. ;
  4345.     intrdef $dtst        ;test if primary is zero
  4346.     jmp    cs:word    ptr $dtsttb
  4347. ;
  4348.     intrdef $dcmp        ;compare primary and secondary
  4349.     jmp    cs:word    ptr $dcmptb
  4350. ;
  4351.     intrdef $dsb        ;subtract secondary from primary
  4352.     jmp    cs:word    ptr $dsbtb
  4353. ;
  4354.     intrdef $dad        ;add secondary to primary
  4355.     jmp    cs:word    ptr $dadtb
  4356. ;
  4357.     intrdef $ddv
  4358.         ;double floating divide    (primary = primary/secondary)
  4359.     jmp    cs:word    ptr $ddvtb
  4360. ;
  4361.     intrdef $dml
  4362.         ;double floating multiply    (primary = primary * secondary)
  4363.     jmp    cs:word    ptr $dmltb
  4364. ;
  4365.     intrdef $utod
  4366.     jmp    cs:word    ptr $utodtb
  4367. ;
  4368.     intrdef $itod
  4369.     jmp    cs:word    ptr $itodtb
  4370. ;
  4371.     intrdef $xtod
  4372.     jmp    cs:word    ptr $xtodtb
  4373. ;
  4374.     intrdef $dtou
  4375.     intrdef $dtoi
  4376.     intrdef $dtox
  4377.     jmp    cs:word    ptr $dtoitb
  4378.  
  4379. INTERNAL equ 1
  4380.     purge    intrdef
  4381. intrdef    macro pname
  4382. pname&86 label near
  4383.     endm
  4384.     include    fsubs.asm
  4385.     purge    intrdef
  4386. intrdef    macro pname
  4387. pname&87 label near
  4388.     endm
  4389.     include    fsubs87.asm
  4390.     purge intrdef
  4391. intrdef    macro    pname
  4392.     public    pname
  4393. ifdef FARPROC
  4394.     pname    label    far
  4395. else
  4396.     pname    label    near
  4397. endif
  4398.     endm
  4399. $floats    endp
  4400.     finish
  4401.     end
  4402. fabs.c
  4403. #ifdef MPU68K
  4404. #define SIGN 0
  4405. #else
  4406. #define SIGN 7
  4407. #endif
  4408.  
  4409. double
  4410. fabs(dou)
  4411. double dou;
  4412. {
  4413.     register char *cp;
  4414.  
  4415.     cp = (char *)&dou;
  4416.     cp[SIGN] &= 0x7f;
  4417.     return dou;
  4418. }
  4419. ne R1 -0.16666666666666665052e+00
  4420. #defin