home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR13 / OS2ASM.ZIP / DOUBLE.ASM < prev    next >
Assembly Source File  |  1991-08-10  |  42KB  |  2,181 lines
  1. ;_double.asm   Mar 3 1991   Modified by: Phil Hinger */
  2. ;$Header$
  3. ;Copyright (C) 1984-1988 by Walter Bright
  4. ;All Rights Reserved, written by Walter Bright
  5. ;Floating point package
  6.  
  7. include macros.asm
  8. include flthead.asm
  9.  
  10.     .8087
  11.  
  12.     ifdef _MT
  13.     if LCODE
  14.     c_extrn    _FEEXCEPT,far
  15.     c_extrn    _FEROUND,far
  16.     else
  17.     c_extrn    _FEEXCEPT,near
  18.     c_extrn    _FEROUND,near
  19.     endif
  20.     endif
  21.  
  22.  
  23.     begdata
  24.     c_extrn _8087,word        ;8087 flag word
  25.  
  26.     ifndef _MT
  27.     extrn    __fe_cur_env:word
  28.     endif
  29.  
  30.     public    _DBL_MAX,_DBL_MIN,_FLT_MAX,_FLT_MIN
  31.  
  32.  
  33. _DBL_MAX    dd    0,longexp    ;maximum double value
  34. _DBL_MIN    dd    0,longhid    ;minimum
  35. _FLT_MAX    dd    shortexp    ;maximum float value
  36. _FLT_MIN    dd    shorthid
  37.  
  38.  
  39.     enddata
  40.  
  41.     begcode    double
  42.  
  43.     ;Note:    0=int    2=unsigned    3=long    4=float    5=double
  44.  
  45.     public        exception, dunnorm, dround, dget_dtype
  46.     public        dleft_justify,dnorm, dget_dtype_pair
  47.     public        __DSUB@
  48.     c_public    _FLTDBL@,_DBLFLT@
  49.     c_public    _DADD@,_DMUL@,_DDIV@,        _DTST@
  50.     c_public    _DTST0@,_DTST0EXC@
  51.     c_public    _DCMP@,_DCMPEXC@
  52.     c_public    _DBLINT@,_INTDBL@,_DBLUNS@,_UNSDBL@
  53.     c_public    _DBLLNG@,_LNGDBL@,_DBLULNG@,_ULNGDBL@
  54.     c_public    __dtype
  55.  
  56. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57. ; Short real:
  58. ;    s | exponent| significand|
  59. ;    31|30      23|22        0|
  60. ; Long real:
  61. ;    s | exponent| significand|
  62. ;    63|62      52|51        0|
  63.  
  64.  
  65. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66. ; Unpack a double. The double must not be 0.
  67. ; Input:
  68. ;    EDX,EAX = the double (with sign = 0)
  69. ; Output:
  70. ;    EDX,EAX = significand (with hidden bit in EDX bit 31)
  71. ;    SI     exponent
  72. ;    EDI    sign (in bit 31)
  73.  
  74.     _align
  75. dunnorm proc    near
  76.     mov    EDI,EDX        ;save sign
  77.     mov    ESI,EDX
  78.     and    ESI,longexp    ;mask off exponent bits
  79.     jne    dunnorm1    ;special case when exponent is zero
  80.     call    dleft_justify
  81.     jmps    dunnorm2
  82. dunnorm1:
  83.     shr    ESI,4+16    ;right-justify exponent
  84.     or    EDX,longhid    ;or in hidden bit
  85. dunnorm2:
  86.     ; EDX,EAX <<= 11
  87.     shld    EDX,EAX,11
  88.     shl    EAX,11
  89.     ret
  90. dunnorm endp
  91.  
  92.  
  93. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  94. ; Left justify mantissa when
  95. ; exponent is zero
  96. ;
  97. ;  Input:
  98. ; [EDX,EAX] = double
  99. ; SI        = Exponent
  100. ;
  101. dleft_justify proc near
  102.     mov    SI,1
  103.  
  104. dleft_justify1:
  105.     dec    SI            ;Adjust exponent
  106.     shl64    EDX,EAX            ;shift mantissa left
  107.     test    EDX,longhid        ;is it shifted enough
  108.     je    dleft_justify1        ;no
  109.     ret
  110. dleft_justify endp
  111.  
  112. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  113. ; Round and normalize and add
  114. ;Input:
  115. ;    [EDX,EAX] = significand
  116. ;    assume bit 7 or 8 of AH is set
  117. ;    if bit 8 of AH is set then
  118. ;         bits 1 and 2 of DH are sticky bits and bit
  119. ;        3 in DH is the guard bit.
  120. ;    else
  121. ;        bits 1 of DH is a sticky bits and bit
  122. ;    2 in AH is the guard bit.
  123. ;    AL = other sticky bits
  124. ;    SI = exponent (biased)
  125. ;    EDI (sign bit)
  126. ;
  127.     _align
  128. dround    proc    near
  129.     dec    SI        ;Make sure exponent is correct if not shifted
  130.     test    EDX,sgn        ;if MSB is set then
  131.     jz    dround1        ;adjust shift register and
  132.     shr64    EDX,EAX
  133.     adc    AL,0        ;make sure sticky bit dit not drop off
  134.     inc    SI        ;adjust exponent
  135.  
  136. dround1:
  137.     _ifs     SI l 07FFh, dround11
  138.     jmp     dpackOverflow
  139.  
  140.  
  141. dround11:
  142.     _ifs SI g 0, dround7
  143.     dec    SI           ;adjustment so it will shift ok
  144.     call    dright_justify    ;shift right until SI is zero
  145.  
  146. dround7:
  147.     test    AH,11b
  148.     jne    dround6
  149.     or    AL,AL
  150.     je    dround5
  151.  
  152. dround6:
  153.     tst    SI
  154.     jne    dround10
  155.     or    __fe_cur_env.status,FE_UNDERFLOW
  156. dround10:
  157.     or    __fe_cur_env.status,  FE_INEXACT    ;no longer exact
  158.     _ifs     __fe_cur_env.round e  FE_TONEAREST, dround3
  159.     _ifs     __fe_cur_env.round e  FE_TOWARDZERO,dround5
  160.     _ifs     __fe_cur_env.round ne FE_DOWNWARD,dround2
  161.  
  162.  
  163.     ;FE_DOWNWARD
  164.     test    EDI,sgn
  165.     jns    dround5
  166.     jmps    dround4
  167.  
  168.  
  169. dround2:;FE_UPWARD
  170.     test    EDI,sgn
  171.     js    dround5
  172.     jmps    dround4
  173.  
  174.  
  175. dround3:;FE_TONEAREST
  176.     test    AH,10b        ;If guard bit is not set then
  177.     jz    dround5        ;no rounding is necessary
  178.     test    AH,101b        ;Test if odd or sticky bits are set
  179.     jne    dround4
  180.     tst    AL        ;Test other sticky bits
  181.     jz    dround5
  182.  
  183.  
  184. dround4:;round up
  185.     add    EAX,0400h
  186.     adc    EDX,0
  187.     tst    SI           ;is exponent zero
  188.     je    dround9        ;yes
  189.  
  190.     test    EDX,sgn   ;is msb still where is should be
  191.     jz    dround5
  192.     inc    SI
  193.     shr64    EDX,EAX
  194.  
  195. dround5:
  196.     shrd    EAX,EDX,10
  197.     shr    EDX,10
  198.     jmp    dpack
  199.  
  200. dround9:            ;when exponent is zero
  201.     test    EDX,40000000h    ;is msb still where is should be
  202.     jz    dround5        ;yes
  203.     inc    SI           ;exponent is now 1
  204.     jmps    dround5
  205. dround    endp
  206.  
  207. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  208. ; Normalize and pack a double.
  209. ; Input:
  210. ;    [EDX,EAX] = significand
  211. ;    SI = exponent (biased)
  212. ;    EDI bit 15 = sign of result
  213. ;
  214. dnorm    proc    near
  215.     sub    SI,11           ;offset
  216.  
  217. dnorm2:
  218.     test    EDX,0FFE00000h    ;do we need to shift right?
  219.     jz    dnorm3        ;no
  220.  
  221. dnorm1:
  222.     shr64    EDX,EAX
  223.     inc    SI           ;exponent
  224.     jnc    dnorm2
  225.     test    EDX,0FFE00000h    ;done shifting yet?
  226.     jnz    dnorm1
  227.  
  228.  
  229. ;see if our significand is 0
  230. dnorm3:
  231.     test    EDX,001F0000h
  232.     jnz    dnorm4
  233.     test    EDX,EDX
  234.     jnz    dnorm5
  235.     shld    EDX,EAX,16
  236.     shl    EAX,16
  237.     sub    SI,16        ;shift left by 16
  238.     tst    EDX
  239.     jnz    dnorm5
  240.     shld    EDX,EAX,16
  241.     clr    EAX        ;EDX,EAX <<= 16
  242.     sub    SI,16
  243.     tst    EDX
  244.     jz    dpack2        ;result is 0
  245.     tst    DH
  246.     jnz    dnorm5
  247.     xchg    DH,DL        ;EDX <<= 8
  248.     sub    SI,8
  249.  
  250.  
  251. dnorm4: test    EDX,longhid     ;hidden bit in right spot?
  252.     jnz    dnorm6        ;no
  253. dnorm5:
  254.     shl64    EDX,EAX     ;shift left till it is
  255.     dec    SI
  256.     jmp    dnorm4
  257.  
  258. dnorm6:
  259.     _ifs SI ge 0, dpack
  260.     shld    EDX,EAX,10
  261.     shl    EAX,10
  262.     dec    SI        ;adjustment so it will shift ok
  263.     call    dright_justify    ;shift right untell SI is zero
  264.     jmp    dround7
  265. dnorm    endp
  266. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  267. ; Pack a double.
  268. ; Input:
  269. ;    [EDX,EAX] = significand
  270. ;    SI = exponent (biased)
  271. ;    EDI bit 15 = sign of result
  272. ;
  273. dpack    proc    near
  274.     shl    ESI,4+16
  275.     _ifs     ESI ae 07FF00000h, dpackOverflow
  276.  
  277.     and    EDX,longhid - 1    ;dump hidden bit
  278.     or    EDX,ESI        ;install exponent
  279.     and    EDI,sgn        ;mask sign bit
  280.     or    EDX,EDI        ;install sign
  281. dpack2:    ret
  282.  
  283. dpackOverflow:
  284.     or    __fe_cur_env.status,FE_OVERFLOW or FE_INEXACT
  285.     mov    EAX,2        ;overflow
  286.     jmp    exception    ;raise overflow exception
  287. dpack    endp
  288.  
  289. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  290. ; Raise underflow/overflow exception
  291. ; Input:
  292. ;    EDI    bit 15 is sign bit of result
  293. ;    EAX    1 = underflow
  294. ;        2 = overflow
  295. ; Returns:
  296. ;    EDX,EDX    adjusted result
  297.  
  298. exception proc near
  299.     clr    EDX
  300.     dec    EAX
  301.     jz    FPV3        ;0 is result for underflow
  302.     mov    EDX,longexp
  303.     clr    EAX
  304.  
  305.     ;Adjust infinity based on rounding mode
  306.     ;NEAREST    infinity with sign
  307.     ;DOWN        + overflows to + largest finite, - overflows to -inf
  308.     ;UP        - overflows to - largest finite, + overflows to +inf
  309.     ;TOZERO        to signed largest finite
  310.  
  311.     _ifs     __fe_cur_env.round e FE_TONEAREST, FPV3
  312.     _ifs     __fe_cur_env.round e FE_TOWARDZERO, FPV1
  313.     _ifs     __fe_cur_env.round e FE_UPWARD, FPV2
  314.  
  315.     tst    EDI
  316.     js    FPV3
  317.     jmps    FPV1
  318.  
  319. FPV2:    tst    EDI
  320.     jns    FPV3
  321.  
  322.     ;Generate largest finite
  323. FPV1:    mov    EDX,07FEFFFFFh
  324.     dec    EAX        ;to 7FEF FFFF FFFF FFFF
  325.  
  326. FPV3:    and    EDI,sgn
  327.     or    EDX,EDI        ;install sign bit
  328.     ret
  329. exception endp
  330.  
  331.  
  332.  
  333. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  334. ; get index of a pair of double
  335. ;    index = (case(b)*dtype_base + case(c)) * 2
  336. ; input:
  337. ;    [ECX,EBX] = b
  338. ;    [EDX,EAX] = c
  339. ; Output:
  340. ;    SI = index
  341. ;
  342. dget_dtype_pair proc near
  343.     clr    ESI                ;set to default
  344.     mov    EDI,ECX
  345.     test    EDI,7fffffffh
  346.     jz    dget_dtype_pair1
  347.  
  348.     and    EDI,longexp                 ;mask exponent
  349.     _ifs    EDI ne long_infinity, dget_dtype_pair2    ;b is not NaN or infinite
  350.     mov    EDI,ECX
  351.     test    EDI,dqnan_bit                 ;bit must be set to be
  352.     jz    dget_dtype_pair3             ;a quit NaN
  353.     mov    SI,dtype_qnan*4                 ;b is a quite NaN
  354.     jmps    dget_dtype_pair2
  355.  
  356. dget_dtype_pair3:
  357.     and    EDI,7ffffh
  358.     or    EDI,EBX                     ;Mantissa must be zero to be infinite
  359.     jz    dget_dtype_pair4             ;otherwise
  360.     mov    SI,dtype_snan*4                 ;b is a signaling NaN
  361.     jmps    dget_dtype_pair2
  362.  
  363. dget_dtype_pair4:                    ;b is infinite
  364.     mov    SI,dtype_infinite*4
  365.     jmps    dget_dtype_pair2
  366.  
  367. dget_dtype_pair1:
  368.     tst    EBX
  369.     jnz    dget_dtype_pair2
  370.     mov    SI,dtype_zero*4                ;b is zero
  371.  
  372. dget_dtype_pair2:
  373.     test    EDX,7fffffffh
  374.     jz    dget_dtype_pair5
  375.  
  376.     mov    EDI,EDX
  377.     and    EDI,longexp                ;mask exponent
  378.     _ifs    EDI ne long_infinity, dget_dtype_pair6 ;c is not NaN or infinite
  379.     mov    EDI,EDX
  380.     test    EDI,dqnan_bit                ;bit must be set to be
  381.     jz    dget_dtype_pair7            ;a quit NaN
  382.     add    SI,dtype_qnan * dtype_base*4        ;c is a quite NaN
  383.     ret
  384.  
  385. dget_dtype_pair7:
  386.     and    EDI,7ffffh
  387.     or    EDI,EAX                    ;Mantissa must be zero to be infinite
  388.     jz    dget_dtype_pair8            ;otherwise
  389.     add    SI,dtype_snan * dtype_base*4        ;c is a signaling NaN
  390.     ret
  391.  
  392. dget_dtype_pair8:                    ;c is infinite
  393.     add    SI,dtype_infinite * dtype_base*4
  394.     ret
  395.  
  396. dget_dtype_pair5:
  397.     tst    EAX
  398.     jnz    dget_dtype_pair6
  399.     add    SI,dtype_zero * dtype_base*4        ;c is zero
  400.  
  401. dget_dtype_pair6:
  402.     ret
  403. dget_dtype_pair endp
  404.  
  405. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  406. ; get special case index of  double
  407. ;    index = case(a)
  408. ; input:
  409. ;    [EDX,EAX] = a
  410. ; Output:
  411. ;    SI = index
  412. ;
  413. dget_dtype proc near
  414.     clr    ESI                ;set to default
  415.     test    EDX,7fffffffh
  416.     jz    dget_dtype1
  417.  
  418.     mov    EDI,EDX
  419.     and    EDI,longexp                ;mask exponent
  420.     _ifs     EDI ne long_infinity, dget_dtype2     ;c is not NaN or infinite
  421.     mov    EDI,EDX
  422.     test    EDI,dqnan_bit                 ;bit must be set to be
  423.     jz    dget_dtype3                ;a quit NaN
  424.     mov    SI,dtype_qnan                    ;c is a quite NaN
  425.     ret
  426.  
  427. dget_dtype3:
  428.     and    EDI,7ffffh
  429.     or    EDI,EAX                    ;Mantissa must be zero to be infinite
  430.     jz    dget_dtype4                ;otherwise
  431.     mov    SI,dtype_snan                    ;c is a signaling NaN
  432.     ret
  433.  
  434. dget_dtype4:                        ;c is infinite
  435.     mov    SI,dtype_infinite
  436.     ret
  437.  
  438. dget_dtype1:
  439.     tst    EAX
  440.     jnz    dget_dtype2
  441.         mov    SI,dtype_zero                ;c is zero
  442.  
  443. dget_dtype2:
  444.     ret
  445. dget_dtype endp
  446.  
  447.  
  448. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  449. ; classify double float
  450. ; input:
  451. ;    [P] = a
  452. ; Output:
  453. ;    AX = classification
  454. ;
  455.      b = P
  456.  
  457.     c_public __fpclassify_d
  458.  
  459. func    __fpclassify_d
  460.     push    EBP
  461.     mov    EBP,ESP
  462.     _push    <ESI,EDI>
  463.     mov    EDX,b+4[EBP]
  464.     mov    EAX,b+[EBP]           ;mov a into registers
  465.     mov    ESI,FP_NORMAL           ;set to default
  466.     mov    EDI,EDX
  467.     and    EDI,longexp           ;mask exponent
  468.     je    fpclassify_d1           ;set if exponent is zero
  469.  
  470.     _ifs    EDI e long_infinity, fpclassify_d2 ;test for NaN or infinite
  471.  
  472. fpclassify_dDone:
  473.     mov    EAX,ESI            ;return classification
  474.     _pop    <EDI,ESI>
  475.     pop    EBP
  476.     ret
  477.  
  478. fpclassify_d2:
  479.     mov    SI,FP_NANQ        ;assumes quiet NaN
  480.     test    EDX,dqnan_bit        ;bit must be set to be
  481.     jnz    fpclassify_dDone    ;a quiet NaN
  482.  
  483.     mov    SI,FP_INFINITE        ;assume Infinity
  484.     mov    EDI,EDX
  485.     and    EDI,mantisa_mask    ;clear sign and exponent
  486.     or    EDI,EAX            ;all ather bit must be zort to be inifite
  487.     jz    fpclassify_dDone    ;otherwise
  488.  
  489.     mov    SI,FP_NANS        ;a is a signaling NaN
  490.     jmps    fpclassify_dDone
  491.  
  492.  
  493. fpclassify_d1:
  494.     mov    SI,FP_ZERO        ;assume Zero
  495.     mov    EDI,EDX
  496.     and    EDI,mantisa_mask    ;drop sign and exponent
  497.     or    EDI,EAX            ;are any other bit set
  498.     jz    fpclassify_dDone
  499.                     ;if not then it must be subnormal
  500.     mov    SI,FP_SUBNORMAL
  501.     jmps    fpclassify_dDone
  502. c_endp    __fpclassify_d
  503.  
  504.  
  505. ;Condition code values
  506. CCeq    equ    40h
  507. CClt    equ    81h
  508. CCgt    equ    00h
  509. CCinv    equ    45h
  510.  
  511. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  512. ; Put into DI the OR of all the significand bits
  513.  
  514. orsigc    proc    near
  515.     mov    EDI,ECX
  516.     and    EDI,mantisa_mask
  517.     or    EDI,EBX
  518.     ret
  519. orsigc    endp
  520.  
  521. orsigb    proc    near
  522.     mov    EDI,EDX
  523.     and    EDI,mantisa_mask
  524.     or    EDI,EAX
  525.     ret
  526. orsigb    endp
  527.  
  528. ;;;;;;;;;;;;;;;;;;;;;;;;;;
  529. ; Test and see if [EDX,EAX] is 0
  530.  
  531.     _align
  532. func    _DTST@
  533.     push    EDX
  534.     shl    EDX,1        ;dump sign bit
  535.     or        EDX,EAX
  536.     pop    EDX
  537.     ret
  538. c_endp    _DTST@
  539.  
  540. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  541. ; Double compare against 0, setting sign bits appropriately
  542. ;    a = b ? 0
  543. ; Input:
  544. ;    [EDX,EAX] = b
  545. ; Output:
  546. ;    [EDX,EAX] = b
  547. ; _DTST0EXC@ is same as _DTST0@, but set invalid exception flag if
  548. ; the operand is a NAN.
  549.  
  550.     _align
  551. func    _DTST0EXC@
  552.     stc
  553.     jmp    short DT9
  554. c_endp    _DTST0EXC@
  555.  
  556.     _align
  557. func    _DTST0@
  558. if 1
  559.     clc
  560. DT9:    push    ESI
  561.     sbb    ESI,ESI              ;SI==-1 if raise exception
  562.     push    EDI
  563.     push    EAX
  564.     push    EDX
  565.  
  566.     ;Test if b is a special value
  567.     mov    EDI,EDX
  568.     and    EDI,longexp
  569.     jz    DT1               ;c is 0 or subnormal
  570.     _ifs    EDI e longexp, DT2       ;c is nan or infinity
  571.  
  572.     ;Do a straightforward comparison
  573. DT3:    tst    EDX
  574.     jz    DT8
  575.     mov    AH,CCgt
  576.     jg    DTret
  577.     mov    AH,CClt
  578. DTret:    ;or    AX,AX            ;OF (overflow flag) is already clear
  579.     sahf
  580.     _pop    <EDX,EAX,EDI,ESI>
  581.     ret
  582.  
  583. DT8:    or    EDX,EAX
  584.     jne    DT7
  585.  
  586. DTeq:    mov    AH,CCeq
  587.     jmp    DTret
  588.  
  589. DT7:    mov    AH,CCgt
  590.     ja    DTret
  591.     mov    AH,CClt
  592.     jmp    DTret
  593.  
  594. DT1:    call    orsigb
  595.     jnz    DT3            ;subnormal
  596.     jmp    DTeq            ;b is 0
  597.  
  598. DT2:    call    orsigb
  599.     jz    DT3            ;b is infinity
  600.  
  601.     ;b is a NAN
  602.     mov    AH,CCinv
  603.     and    SI,FE_INVALID
  604.     or    __fe_cur_env.status,SI
  605.     jmp    DTret
  606. else
  607.     push    EDX
  608.     tst    EDX
  609.     js    TST01
  610.     or    EDX,EAX
  611.     neg    EDX
  612.     sbb    EDX,EDX
  613.     neg    EDX
  614.     pop    EDX
  615.     ret
  616.  
  617. TST01:
  618.     shl    EDX,1
  619.     or    EDX,EAX
  620.     neg    EDX            ;C=1 if b!=0
  621.     sbb    EDX,EDX            ;if (b==0) EDX=0 else EDX=-1
  622.     pop    EDX
  623.     ret
  624.  
  625. endif
  626. c_endp    _DTST0@
  627.  
  628. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  629. ; Double compare
  630. ;    a = b ? c
  631. ; Input:
  632. ;    EDX,EAX = b
  633. ;    ECX,EBX = c
  634. ; Output:
  635. ;    no registers changed
  636. ;    Condition codes set same as 8087 would
  637. ;    (but also set SF and OF so that pre-3.0 code will link which
  638. ;    used signed jmps after DCMP)
  639. ;
  640. ; _DCMPEXC@ is same as _DCMP@, but set invalid exception flag if
  641. ; either of the operands are NAN.
  642.  
  643. if 1
  644.     _align
  645. func    _DCMPEXC@
  646.     stc
  647.     jmp    short DC9
  648. c_endp    _DCMPEXC@
  649.  
  650.     _align
  651. func    _DCMP@
  652.     clc
  653. DC9:
  654.  
  655.     push    ESI
  656.     sbb    ESI,ESI              ;SI==-1 if raise exception
  657.     push    EDI
  658.     push    ECX
  659.     push    EAX
  660.  
  661.     ;Test if c is a special value
  662.     mov    EDI,ECX
  663.     and    EDI,longexp
  664.     jz    DC1             ;c is 0 or subnormal
  665.     _ifs     EDI e longexp, DC2    ;c is nan or infinity
  666.  
  667.     ;Test if b is a special value
  668. DC3:    mov    EDI,EDX
  669.     and    EDI,longexp
  670.     jz    DC4            ;b is 0 or subnormal
  671.     _ifs    EDI e longexp, DC5     ;b is nan or infinity
  672.  
  673.     ;Do a straightforward comparison
  674. DC6:    mov    EDI,ECX
  675.     xor    EDI,EDX
  676.     js    DC8            ;signs are different
  677.     _ifs    EDX ne ECX, DC7
  678.     _ifs    EAX ne EBX, DC7
  679.  
  680. DCeq:    mov    AH,CCeq
  681. DCret:    or    AX,AX            ;clear OF (overflow flag)
  682.     sahf
  683.     pop    EAX
  684.     pop    ECX
  685.     pop    EDI
  686.     pop    ESI
  687.     ret
  688.  
  689. DC7:
  690.     mov    AH,CCgt
  691.     ja    DC10
  692.     mov    AH,CClt
  693. DC10:    test    ECX,sgn
  694.     jns    DCret
  695.     xor    AH,CCgt XOR CClt
  696.     jmp    DCret
  697.  
  698. DC8:    test    ECX,sgn
  699.     mov    AH,CClt
  700.     jns    DCret
  701.     mov    AH,CCgt
  702.     jmp    DCret
  703.  
  704. DC1:    call    orsigc
  705.     jnz    DC3            ;subnormal
  706.     ;c is +0 or -0
  707.     and    ECX,sgn_mask        ;no -0 bugs
  708.     jmp    DC3            ;c is 0
  709.  
  710. DC2:    call    orsigc
  711.     jz    DC3            ;c is infinity
  712.     jmp    short DCinv        ;c is a nan
  713.  
  714. DC4:    call    orsigb
  715.     jnz    DC6            ;b is subnormal
  716.     ;c is +0 or -0
  717.     and    EDX,sgn_mask         ;no -0 bugs
  718.     jmp    DC6            ;b is 0
  719.  
  720. DC5:    call    orsigb
  721.     jz    DC6            ;b is infinity
  722. ;    jmp    DCinv            ;b is a nan
  723.  
  724. DCinv:    mov    AH,CCinv
  725.     and    SI,FE_INVALID
  726.     or    __fe_cur_env.status,SI
  727.     jmp    DCret
  728. c_endp    _DCMP@
  729.  
  730. else
  731.     _align
  732. func    _DCMP@
  733.     push    EDI
  734.     push    EDX
  735.     push    ECX
  736.  
  737.     ;test if c is 0
  738.     mov    EDI,ECX
  739.     shl    EDI,1            ;dump sign bit
  740.     or        EDI,EBX
  741.     jnz    C3            ;no
  742.     and    ECX,7F000000h        ;no -0 bugs
  743. C3:
  744.     mov    EDI,EDX
  745.     shl    EDI,1            ;dump sign bit
  746.     or    EDI,EAX
  747.     jnz    C2            ;no
  748.     and    EDX,7F000000h        ;convert -0 to 0
  749. C2:
  750.     mov    EDI,EDX
  751.     xor    EDI,ECX
  752.     js    C52            ;signs are different
  753.     mov    EDI,1            ;1 for positive compares
  754.     tst    ECX
  755.     jns    C51
  756.     neg    EDI            ;-1 for negative compares
  757. C51:    _ifs    EDX ne ECX, C6        ;compare MSW
  758.     _ifs    EAX e EBX, L21        ;compare LSW
  759. C6:    ja    C7
  760.     neg    EDI
  761. C7:    tst    EDI
  762. L21:    pop    ECX
  763.     pop    EDX
  764.     pop    EDI
  765.     ret
  766.  
  767. C52:    cmp    EDX,ECX
  768.     jmp    L21
  769. c_endp    _DCMP@
  770. endif
  771.  
  772.  
  773.  
  774. ;;;;
  775. ; Right justifty mantissa when
  776. ; exponent is less then zero
  777. ;
  778. ;  Input:
  779. ;  [AX,BX,CX,DX] = double
  780. ;  SI         = Exponent
  781. ;
  782. dright_justify proc near
  783.     _ifs SI l -56, dright_justify5
  784.  
  785. dright_justify1:
  786.     _ifs     SI g -8, dright_justify2
  787.     sh64StyRBy8
  788.     add    SI,8
  789.     jnz    dright_justify1
  790.  
  791. dright_justify2:
  792.     xchg    ECX,ESI
  793.     and    ECX,0ffffh    ;make sure top is clear
  794.     jcxz    dright_justify3    ;no shifting need be done
  795.     neg    CX
  796.     or    AL,AL        ;If any sticky bits are set then
  797.     je    dright_justify4    ;make sure they don't all rotate out
  798.     or    AL,40h
  799.  
  800. dright_justify4:
  801.     shr64    EDX,EAX
  802.     loop    dright_justify4
  803.  
  804. dright_justify3:
  805.     xchg    ECX,ESI          ;restore CX, SI = 0
  806.     ret
  807.  
  808. dright_justify5:
  809.     or    EAX,EDX
  810.     je    dright_justify6
  811.     clr    EDX
  812.     mov    EAX,1
  813.  
  814. dright_justify6:
  815.     mov    SI,DX
  816.     ret
  817. dright_justify endp
  818. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  819. ; Double floating add/subtract.
  820. ;    a = b +(-) c
  821. ; Input:
  822. ;    [ECX,EBX]  = b
  823. ;    [EDX,EAX]  = c
  824. ; Output:
  825. ;    a = [EDX,EAX]
  826. ;    SI,DI = preserved
  827. ; Stack offsets
  828.  
  829.  
  830.     padnn     =    24    ;so nn == dd == mm == 50
  831.     sign     =    padnn+8
  832.     signc     =    sign+4
  833.     subtract =    signc+4
  834.     exp     =    subtract+4
  835.     orgsign  =    exp+2
  836.     nn     =    orgsign+4
  837.     b     =    nn+P
  838.  
  839.  
  840.  
  841.  
  842. __DSUB@:
  843.     push    EBP
  844.     sub    ESP,nn         ;make room for nn variables
  845.     mov    EBP,ESP
  846.     _ifs     __8087 e 0, A6          ;if no 8087
  847.     mov    0[EBP],EAX
  848.     mov    4[EBP],EDX
  849.     fld    qword ptr 0[EBP]    ;load b
  850.     _push    <ECX,EBX>        ;push c
  851.     fsub    qword ptr -8[EBP]    ;add c
  852.     jmps    fltret
  853.  
  854. A6:
  855.     mov    dword ptr orgsign[EBP],sgn ;need to flip sign back on  NaNs
  856.     xor    ECX,sgn             ;flip sign for subtraction
  857.     jmps    A1
  858.  
  859.     _align
  860. func    _DADD@
  861.     push    EBP
  862.     sub    ESP,nn             ;make room for nn variables
  863.     mov    EBP,ESP
  864.     mov    dword ptr orgsign[EBP],0 ;need for NaN
  865.     _ifs     __8087 e 0, A1          ;if no 8087
  866.     mov    0[EBP],EAX
  867.     mov    4[EBP],EDX
  868.     fld    qword ptr 0[EBP]    ;load b
  869.     _push    <ECX,EBX>        ;push c
  870.     fadd    qword ptr -8[EBP]    ;add c
  871.  
  872. fltret:
  873.     ;Check for floating point error
  874.     fstsw    -2[EBP]
  875.     fwait
  876.     mov    AX,-2[EBP]
  877.     and    AX,FE_ALL_EXCEPT
  878.     jnz    fltret5            ;jmp if error
  879. fltret4:
  880.     fstp    qword ptr -8[EBP]
  881.     fwait                ;wait for finish
  882.     _pop    <EAX,EDX>        ;pop results
  883.     add    ESP,nn
  884.     pop    EBP
  885.     ret
  886.  
  887. fltret5:
  888.     or    __fe_cur_env.status,AX
  889.     jmp    fltret4
  890.  
  891.  
  892. A1:
  893.     push    EDI
  894.     push    ESI
  895.     call    dget_dtype_pair
  896.     jmp    dword ptr cs:Daddindex[ESI]
  897.  
  898. Daddindex    label    dword
  899.     dd    ANormalAdd        ;other + other
  900.     dd    AFirstIsAnswer        ;other + zero
  901.     dd    ASecondIsAnswer        ;other + infinite
  902.     dd    ASecondAsQNaN        ;other + SNaN
  903.     dd    ASecondQNaN        ;other + QNaN
  904.  
  905.     dd    ASecondIsAnswer        ;zero + other
  906.     dd    Azeros            ;zero + zero
  907.     dd    ASecondIsAnswer        ;zero + infinite
  908.     dd    ASecondAsQNaN        ;zero + SNaN
  909.     dd    ASecondQNaN        ;zero + QNaN
  910.  
  911.     dd    AFirstIsAnswer        ;infinite + other
  912.     dd    AFirstIsAnswer        ;infinite + zero
  913.     dd    AInfiniteInfinite    ;infinite + infinite
  914.     dd    ASecondAsQNaN        ;infinite + SNaN
  915.     dd    ASecondQNaN        ;infinite + QNaN
  916.  
  917.     dd    AFirstAsQNaN           ;SNaN + other
  918.     dd    AFirstAsQNaN        ;SNaN + zero
  919.     dd    AFirstAsQNaN        ;SNaN + infinite
  920.     dd    ALargestSNaNasQNaN    ;SNaN + SNaN
  921.     dd    ASecondAsQNaN        ;SNaN + QNaN
  922.  
  923.     dd    AFirstQNaN        ;QNaN + other
  924.     dd    AFirstQNaN        ;QNaN + zero
  925.     dd    AFirstQNaN        ;QNaN + infinite
  926.     dd    AFirstAsQNaN        ;QNaN + SNaN
  927.     dd    ALargestQNaN        ;QNaN + QNaN
  928.  
  929. ANormalAdd:
  930.  
  931.     mov    signc[EBP],EDX      ;Save sign
  932.     mov    EDI,ECX
  933.     mov    sign[EBP],EDI
  934.     xor    EDI,EDX        ;if sign(b) != sign(c), then subtraction
  935.     mov    subtract[EBP],EDI ;flag for subtraction
  936.  
  937.     call    dunnorm        ;unpack second operand (c)
  938.     mov    exp[EBP],SI    ;save exponent of c
  939.     xChgReg64          ;exchange regs
  940.     call    dunnorm        ;unpack first operand (b)
  941.     sub    SI,exp[EBP]    ;SI = exp(b) - exp(c)
  942.     jle    A2        ;exp(b) > exp(c)
  943.     add    exp[EBP],SI    ;exponent is b
  944.     xChgReg64
  945.     neg    SI
  946.     mov    EDI,signc[EBP]
  947.     mov    sign[EBP],EDI          ;reset sign
  948. A2:
  949.     call    dright_justify
  950.     test    dword ptr subtract[EBP],sgn ;subtracting? (test bit 15)
  951.     je    A3            ;no
  952.  
  953.     sub    EAX,EBX
  954.     sbb    EDX,ECX
  955.  
  956.     jnc    A4            ;no borrow
  957.     xor    dword ptr sign[EBP],sgn  ;toggle sign of result
  958.     neg64                ;SI must be 0 for this to work
  959.  
  960. A4:
  961.     test    EDX,0C0000000h        ;if bit 8 or 7 are set then
  962.     jnz    A5                ;do normal round
  963.     mov    EDI,EDX
  964.     or    EDI,EAX            ;is result zero
  965.     je    Azeros1            ;yes
  966.  
  967.     mov    EDI,sign[EBP]
  968.     mov    SI,exp[EBP]        ;exponent of result
  969.     call    dnorm            ;normalize and pack
  970.     jmp    ADone
  971.  
  972. A3:
  973.     add    EAX,EBX
  974.     adc    EDX,ECX
  975.     jnc    A5
  976.     rcr    EDX,1
  977.     rcr    EAX,1
  978.     inc    word ptr exp[EBP]      ;bump exponent
  979.  
  980. A5:
  981.     mov    EDI,sign[EBP]
  982.     mov    SI,exp[EBP]           ;exponent of result
  983.     call    dround               ;round and normalize
  984.     jmp    ADone
  985.  
  986.  
  987. Azeros:
  988.     mov    EDI,EDX
  989.     xor    EDI,ECX
  990.     test    EDI,sgn            ;are signs the same
  991.     jne    Azeros1
  992.     jmp    ADone            ;yes
  993.  
  994. Azeros1:
  995.     clr    EDX
  996.     _ifs     __fe_cur_env.round e FE_DOWNWARD,Azeros2
  997.     jmp    AFirstIsAnswer
  998. Azeros2:
  999.     mov    EDX,sgn               ;set sign to -
  1000.     jmps    AFirstIsAnswer
  1001.     
  1002. AInfiniteInfinite:
  1003.     mov    EDI,EDX
  1004.     xor    EDI,ECX
  1005.     test    EDI,sgn            ;are signs the same
  1006.     je    AFirstIsAnswer        ;yes
  1007.  
  1008.                     ;Default invalid operation
  1009.     mov    EDX,long_qnan OR 2000h
  1010.     clr    EAX
  1011.     or    __fe_cur_env.status,FE_INVALID
  1012.     jmps    ADone
  1013.  
  1014.  
  1015. ASecondAsQNaN:
  1016.     or    ECX,dqnan_bit
  1017.     or    __fe_cur_env.status,FE_INVALID
  1018.     jmps    ASecondQNaN
  1019.  
  1020.  
  1021. ALargestSNaNasQNaN:
  1022.     or    EDX,dqnan_bit
  1023.     or    ECX,dqnan_bit
  1024.     or    __fe_cur_env.status,FE_INVALID
  1025.  
  1026. ALargestQNaN:
  1027.     xor    ECX,orgsign[EBP]          ;reset orginal sign
  1028.     mov    ESI,EDX
  1029.     and    ESI,sgn_mask
  1030.     mov    EDI,ECX
  1031.     and    EDI,sgn_mask
  1032.     _ifs    ESI a EDI, AFirstIsAnswer
  1033.     jb    ASecondQNaN
  1034.     _ifs    EAX ae EBX, AFirstIsAnswer
  1035.  
  1036. ASecondQNaN:
  1037.     
  1038.     xor    ECX,orgsign[EBP]      ;reset orginal sign
  1039. ASecondIsAnswer:
  1040.     mov    EDX,ECX
  1041.     mov    EAX,EBX
  1042.     jmps    ADone
  1043.  
  1044. AFirstAsQNaN:
  1045.     or    EDX,dqnan_bit
  1046.     or    __fe_cur_env.status,FE_INVALID
  1047.  
  1048. AFirstQNaN:
  1049.  
  1050. AFirstIsAnswer:
  1051.  
  1052. ADone:
  1053.     pop    ESI
  1054.     pop    EDI
  1055.     add    ESP,nn
  1056.     pop    EBP
  1057.     ret
  1058. c_endp    _DADD@
  1059.  
  1060.  
  1061. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1062. ; Double floating divide.
  1063. ;    a = b / c
  1064. ; Input:
  1065. ;    [ECX,EBX] = b
  1066. ;    [EDX,EAX] = c
  1067. ; Output:
  1068. ;    a = [EAX,EAX]
  1069. ;    ESI,EDI preserved
  1070.  
  1071. ; Stack offsets:
  1072.  
  1073.     paddd    =    24        ;so nn == cxdd == mm == 50
  1074.     resp    =    paddd+16    ;pointer to result
  1075.     sign    =    resp+2        ;sign of result
  1076.     exp    =    sign+4        ;exponent of result
  1077.     count    =    exp+2        ;loop counter
  1078.     cxdd    =    count+2        ;amount of local variables
  1079.  
  1080. func    _DDIV@
  1081.     push    EBP
  1082.     sub    ESP,cxdd
  1083.     mov    EBP,ESP
  1084.  
  1085.     _ifs     __8087 e 0, D7          ;if no 8087
  1086.     mov    0[EBP],EAX
  1087.     mov    4[EBP],EDX
  1088.     fld    qword ptr 0[EBP]    ;load b
  1089.     _push    <ECX,EBX>        ;push c
  1090.     fdiv    qword ptr -8[EBP]    ;div c
  1091.     jmp    fltret
  1092.  
  1093. D7:    push    ESI
  1094.     push    EDI
  1095.  
  1096.     mov    sign[EBP],EDX              ;transfer sig(b) to 0[EBP]
  1097.     xor    sign[EBP],ECX
  1098.     and    dword ptr sign[EBP],sgn
  1099.     call    dget_dtype_pair
  1100.     jmp    dword ptr cs:Dindex[ESI]
  1101.  
  1102.     _align
  1103. Dindex    label    dword
  1104.     dd    DNormalDivide        ;other / other
  1105.     dd    DDivideByZero        ;other / zero
  1106.     dd    DSignedZero        ;other / infinite
  1107.     dd    DSecondAsQNaN        ;other / SNaN
  1108.     dd    DSecondQNaN        ;other / QNaN
  1109.  
  1110.     dd    DSignedZero        ;zero / other
  1111.     dd    DDefaultQNaN        ;zero / zero
  1112.     dd    DSignedZero        ;zero / infinite
  1113.     dd    DSecondAsQNaN        ;zero / SNaN
  1114.     dd    DSecondQNaN        ;zero / QNaN
  1115.  
  1116.     dd    DSignedInfinite        ;infinite / other
  1117.     dd    DSignedInfinite        ;infinite / zero
  1118.     dd    DDefaultQNaN        ;infinite / infinite
  1119.     dd    DSecondAsQNaN        ;infinite / SNaN
  1120.     dd    DSecondQNaN        ;infinite / QNaN
  1121.  
  1122.     dd    DFirstAsQNaN        ;SNaN / other
  1123.     dd    DFirstAsQNaN        ;SNaN / zero
  1124.     dd    DFirstAsQNaN        ;SNaN / infinite
  1125.     dd    DLargestSNaNasQNaN    ;SNaN / SNaN
  1126.     dd    DSecondAsQNaN        ;SNaN / QNaN
  1127.  
  1128.     dd    DFirstQNaN        ;QNaN / other
  1129.     dd    DFirstQNaN        ;QNaN / zero
  1130.     dd    DFirstQNaN        ;QNaN / infinite
  1131.     dd    DFirstAsQNaN        ;QNaN / SNaN
  1132.     dd    DLargestQNaN        ;QNaN / QNaN
  1133.  
  1134.  
  1135. DNormalDivide:
  1136.     ;unpack c
  1137.     mov    EDI,ECX
  1138.     and    EDI,longexp         ;mask off exponent bits
  1139.     and    ECX,0fffffh        ;remove exponent from mantissa
  1140.     tst    EDI            ;is exponent zero
  1141.     jnz    D12
  1142.                     ;special case when exponent is zero
  1143.     xChgReg64              ;may need to do a lot of shifting
  1144.     call    dleft_justify        ;msb must be block to left
  1145.     xChgReg64
  1146.     mov    DI,SI        ;save exponent
  1147.     jmps    D13
  1148. D12:
  1149.     or    ECX,longhid
  1150.     shr    EDI,16+4
  1151. D13:
  1152.     
  1153.     ;unpack b
  1154.     mov    ESI,EDX
  1155.     and    ESI,longexp        ;mask off exponent bits
  1156.     and    EDX,0fffffh        ;remove exponent from mantissa
  1157.     tst    ESI            ;is exponent zero
  1158.     jnz    D14
  1159.                     ;special case when exponent is zero
  1160.     call    dleft_justify        ;msb must be block to left
  1161.     jmps    D15
  1162. D14:
  1163.     or    EDX,longhid           ;or in hidden bit
  1164.     shr    ESI,16 + 4
  1165. D15:
  1166.     sub    SI,DI            ;exp(result) = exp(b) - exp(c)
  1167.     add    SI,longbias        ;so bias is retained after subtraction
  1168.     mov    exp[EBP],SI        ;exponent of result
  1169.  
  1170.     mov    ESI,ECX            ;free up CX for loop counter
  1171. ;;;;;;;
  1172.     ;if (b >= c) goto D31 else D41
  1173.     mov    ECX,55             ;16 bits per word
  1174.     mov    DI,1            ;used to count to 16
  1175.     
  1176.     _align
  1177. D51:    _ifs    EDX a ESI, D31
  1178.     jb    D41
  1179.     _ifs    EAX b EBX, D41
  1180.  
  1181.     ;b -= c
  1182.  
  1183. D31:    sub    EAX,EBX
  1184.     sbb    EDX,ESI            ;since b > c, C == 0
  1185.  
  1186. D41:    rcl    EDI,1            ;0 if we subtracted, 1 if not
  1187.     jc    D71            ;push value every 16 loops
  1188.  
  1189. D61:    shl64    EDX,EAX              ;b <<= 1
  1190.     loop    D51
  1191.  
  1192.     or    EAX,EDX
  1193.     je    D63
  1194.     mov    AL,1
  1195. D63:
  1196.     and    EAX,1
  1197.     mov    EDX,EDI
  1198.     not    EDX
  1199.     shl    EDX,9             ;shift out count
  1200.     or    EAX,EDX
  1201. ;;;;;;;
  1202.  
  1203.     pop    EDX             ;load sig(result)
  1204.     mov    SI,exp[EBP]
  1205.     mov    EDI,sign[EBP]
  1206.     call    dround            ;round and normalize result
  1207.     jmp    DDone
  1208.  
  1209.  
  1210. D71:    not    EDI             ;push next mantissa on stack
  1211.     push    EDI
  1212.     clr    EDI
  1213.     jmps    D61
  1214.  
  1215. DDivideByZero:
  1216.     or    __fe_cur_env.status,FE_DIVBYZERO
  1217.  
  1218. DSignedInfinite:
  1219.     mov    EDX,sign[EBP]
  1220.     or    EDX,long_infinity
  1221.     clr    EAX
  1222.     jmps    DDone
  1223.  
  1224. DSignedZero:
  1225.     mov    EDX,sign[EBP]
  1226.     clr    EAX
  1227.     jmps    DDone
  1228.  
  1229. DSecondAsQNaN:
  1230.     or    ECX,dqnan_bit
  1231.     or    __fe_cur_env.status,FE_INVALID
  1232.  
  1233. DSecondQNaN:
  1234.     xChgReg64
  1235.     jmps    DDone
  1236.  
  1237.     _align
  1238. DDefaultQNaN:
  1239.     mov    EDX,long_qnan OR 2000h
  1240.     or    EDX,sign[EBP]
  1241.     or    __fe_cur_env.status,FE_INVALID
  1242.     jmps    DDone
  1243.  
  1244.  
  1245. DLargestSNaNasQNaN:
  1246.     or    EDX,dqnan_bit
  1247.     or    ECX,dqnan_bit
  1248.     or    __fe_cur_env.status,FE_INVALID
  1249.  
  1250. DLargestQNaN:
  1251.     mov     ESI,EDX
  1252.     and     ESI,sgn_mask
  1253.     mov     EDI,ECX
  1254.     and     EDI,sgn_mask
  1255.     _ifs     ESI a EDI, DFirstQNaN
  1256.     jb     DSecondQNaN
  1257.     _ifs     EAX ae EBX, DFirstQNaN
  1258.     jmps     DSecondQNaN
  1259.  
  1260. DFirstAsQNaN:
  1261.     or    EDX,dqnan_bit
  1262.     or    __fe_cur_env.status,FE_INVALID
  1263. DFirstQNaN:
  1264.  
  1265. DDone:
  1266.     pop    EDI
  1267.     pop    ESI
  1268.     add    ESP,cxdd
  1269.     pop    EBP
  1270.     ret
  1271. c_endp    _DDIV@
  1272.  
  1273.  
  1274. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1275. ; Double floating multiply.
  1276. ;    a = b * c
  1277. ; Input:
  1278. ;    [EBP] = b
  1279. ;    [EDX,EAX] = c
  1280. ; Output:
  1281. ;    a = [EDX,EAX]
  1282. ;    SI,DI preserved
  1283.  
  1284. ; Stack offsets:
  1285.  
  1286.     padmm    =    32    ;so nn == dd == mm == 50
  1287.     sign    =    padmm+8        ;sig(b) + sig(c) + sig(result)
  1288.     exp    =    sign+4
  1289.     count    =    exp+4
  1290.     mm    =    count+2
  1291.      b    =    mm + P
  1292.  
  1293.     _align
  1294. func    _DMUL@
  1295.     push    EBP
  1296.     sub    ESP,mm
  1297.     mov    EBP,ESP
  1298.     _ifs    __8087 e 0, M1        ;if no 8087
  1299.  
  1300.     mov    0[EBP],EAX
  1301.     mov    4[EBP],EDX
  1302.     fld    qword ptr 0[EBP]    ;load b
  1303.     _push    <ECX,EBX>        ;push c
  1304.     fmul    qword ptr -8[EBP]    ;mul c
  1305.     jmp    fltret
  1306.  
  1307. M1:    push    ESI
  1308.     push    EDI
  1309.  
  1310.     mov    sign[EBP],EDX              ;transfer sig(b) to 0[EBP]
  1311.     xor    sign[EBP],ECX
  1312.     and    dword ptr sign[EBP],sgn
  1313.     call    dget_dtype_pair
  1314.     jmp    dword ptr cs:Mindex[ESI]
  1315.  
  1316.     _align
  1317. Mindex    label    dword
  1318.     dd    MNormalMultiply        ;other * other
  1319.     dd    MSignedZero        ;other * zero
  1320.     dd    MSignedInfinite        ;other * infinite
  1321.     dd    MSecondAsQNaN        ;other * SNaN
  1322.     dd    MSecondQNaN        ;other * QNaN
  1323.  
  1324.     dd    MSignedZero        ;zero * other
  1325.     dd    MSignedZero        ;zero * zero
  1326.     dd    MDefaultQNaN        ;zero * infinite
  1327.     dd    MSecondAsQNaN        ;zero * SNaN
  1328.     dd    MSecondQNaN        ;zero * QNaN
  1329.  
  1330.     dd    MSignedInfinite        ;infinite * other
  1331.     dd    MDefaultQNaN        ;infinite * zero
  1332.     dd    MSignedInfinite        ;infinite * infinite
  1333.     dd    MSecondAsQNaN        ;infinite * SNaN
  1334.     dd    MSecondQNaN        ;infinite * QNaN
  1335.  
  1336.     dd    MFirstAsQNaN        ;SNaN * other
  1337.     dd    MFirstAsQNaN        ;SNaN * zero
  1338.     dd    MFirstAsQNaN        ;SNaN * infinite
  1339.     dd    MLargestSNaNasQNaN    ;SNaN * SNaN
  1340.     dd    MSecondAsQNaN        ;SNaN * QNaN
  1341.  
  1342.     dd    MFirstQNaN        ;QNaN * other
  1343.     dd    MFirstQNaN        ;QNaN * zero
  1344.     dd    MFirstQNaN        ;QNaN * infinite
  1345.     dd    MFirstAsQNaN        ;QNaN * SNaN
  1346.     dd    MLargestQNaN        ;QNaN * QNaN
  1347.  
  1348.  
  1349. MNormalMultiply:
  1350.     call    dunnorm        ;unpack second operand (c)
  1351.     mov    exp[EBP],SI    ;save exponent of c
  1352.     xChgReg64          ;may need to do a lot of shifting
  1353.     call    dunnorm        ;unpack second operand (b)
  1354.     sub    SI,longbias - 1 ;so bias is retained after add
  1355.     add    exp[EBP],SI    ;exponent of result
  1356.  
  1357.     mov    ESI,EDX        ; save b is [ESI,EDI]
  1358.     mov    EDI,EAX
  1359.  
  1360.                 ;b_low * c_low
  1361.     mul    EBX
  1362.     mov    [EBP],EAX
  1363.     mov    4[EBP],EDX
  1364.  
  1365.                 ;b_high * c_low
  1366.     mov    EAX,ESI
  1367.     mul    EBX
  1368.     add    4[EBP],EAX
  1369.     adc    EDX,0
  1370.     mov    EBX,EDX          ;BX now free
  1371.     
  1372.                 ;b_low * c_high
  1373.     mov    EAX,EDI
  1374.     mul    ECX
  1375.     clr    EDI         ;DI now free
  1376.     add    4[EBP],EAX
  1377.     adc    EBX,EDX
  1378.     adc    EDI,0         ;save overflow bit
  1379.  
  1380.                 ;b_high * c_high
  1381.     mov    EAX,ESI
  1382.     mul    ECX
  1383.     add    EAX,EBX
  1384.     adc    EDX,EDI
  1385.  
  1386.     mov    ECX,[EBP]
  1387.     or    ECX,4[EBP]
  1388.     je    M2
  1389.     or    EAX,1         ;save sticky bits
  1390. M2:
  1391.     mov    SI,exp[EBP]
  1392.     mov    EDI,sign[EBP]
  1393.     call    dround        ;round and normalize result
  1394.     jmp    MDone
  1395.  
  1396. MSignedInfinite:
  1397.     mov    EDX,sign[EBP]
  1398.     or    EDX,long_infinity
  1399.     clr    EAX
  1400.     jmps    MDone
  1401.  
  1402. MSignedZero:
  1403.     mov    EDX,sign[EBP]
  1404.     clr    EAX
  1405.     jmps    MDone
  1406.  
  1407. MSecondAsQNaN:
  1408.     or    ECX,dqnan_bit
  1409.     or    __fe_cur_env.status,FE_INVALID
  1410.  
  1411. MSecondQNaN:
  1412.     xChgReg64
  1413.     jmps    MDone
  1414.  
  1415.     _align
  1416. MDefaultQNaN:
  1417.     mov    EDX,long_qnan
  1418.     or    EDX,sign[EBP]
  1419.     or    __fe_cur_env.status,FE_INVALID
  1420.     jmps    MDone
  1421.  
  1422.  
  1423. MLargestSNaNasQNaN:
  1424.     or    EDX,dqnan_bit
  1425.     or    ECX,dqnan_bit
  1426.     or    __fe_cur_env.status,FE_INVALID
  1427.  
  1428. MLargestQNaN:
  1429.     mov    ESI,EDX
  1430.     and    ESI,sgn_mask
  1431.     mov    EDI,ECX
  1432.     and    EDI,sgn_mask
  1433.     _ifs    ESI a EDI, MFirstQNaN
  1434.     jb    MSecondQNaN
  1435.     _ifs    EAX ae EBX,MFirstQNaN
  1436.     jmps    MSecondQNaN
  1437.  
  1438. MFirstAsQNaN:
  1439.     or    EDX,dqnan_bit
  1440.     or    __fe_cur_env.status,FE_INVALID
  1441. MFirstQNaN:
  1442.  
  1443. MDone:
  1444.     pop    EDI
  1445.     pop    ESI
  1446.     add    ESP,mm
  1447.     pop    EBP
  1448.     ret
  1449.  
  1450. c_endp    _DMUL@
  1451. ;;;;;;;;;;;;;;;;;;;;;;;;;;
  1452.     b     =    P
  1453.  
  1454. func    __dtype
  1455.     push    EBP
  1456.     mov    EBP,ESP
  1457.     _push    <ESI,EDI,EBX>
  1458.     mov    EDX,b+4[EBP]
  1459.     mov    EAX,b[EBP]         ;mov b into registers
  1460.     call    dget_dtype
  1461.     mov    EAX,ESI
  1462.     _pop    <EBX,EDI,ESI>
  1463.     pop    EBP
  1464.     ret
  1465. c_endp    __dtype
  1466.  
  1467.  
  1468. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1469. ; Convert unsigned short to double.
  1470. ; ESI,EDI preserved.
  1471.  
  1472. func    _UNSDBL@
  1473.     clc
  1474.     jmps    INTDBL2
  1475. c_endp    _UNSDBL@
  1476.  
  1477. ; Convert short to double
  1478.  
  1479. func    _INTDBL@
  1480.     _ifs    __8087 e 0, INTDBL1    ;if no 8087
  1481.     sub    ESP,4            ;2 extra words
  1482.     push    EAX
  1483.     fild    word ptr [ESP]        ;load integer into 8087
  1484. INTDBL3:
  1485.     fstp    qword ptr [ESP]
  1486.     fwait            ;wait for it to finish
  1487.     _pop    <EAX,EDX>    ;pop result
  1488.     ret
  1489.  
  1490. INTDBL1:
  1491.     or    AX,AX            ;negative? (also clear C)
  1492.     jns    INTDBL2            ;no
  1493.     neg    AX            ;abs value (also set C)
  1494. INTDBL2:
  1495.     _push    <ESI,EDI>
  1496.     rcr    EDI,1            ;bit 15 becomes sign of result
  1497.     mov    EDX,EAX
  1498.     shl    EDX,16
  1499.     clr    EAX
  1500.     mov    ESI,15+longbias        ;2^15
  1501.     call    dnorm            ;pack result into a double
  1502.     _pop    <EDI,ESI>
  1503.     ret
  1504. c_endp    _INTDBL@
  1505.  
  1506. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1507. ; Convert unsigned long to double.
  1508. ; SI,DI preserved.
  1509.  
  1510. func    _ULNGDBL@
  1511.     clc
  1512.     jmps    A8
  1513. c_endp    _ULNGDBL@
  1514.  
  1515. ; Convert long to double.
  1516.  
  1517. func    _LNGDBL@
  1518.     _ifs    __8087 e 0, A12        ;if no 8087
  1519.     sub    ESP,4            ;2 extra words
  1520.     push    EAX
  1521.     fild    dword ptr [ESP]        ;load long into 8087
  1522.     jmp    INTDBL3
  1523.  
  1524. A12:    or    EAX,EAX            ;negative? (also clear C)
  1525.     jns    A8            ;no
  1526.     neg    EAX            ;abs value
  1527.     stc                ;indicate negative result
  1528. A8:    _push    <ESI,EDI>
  1529.     rcr    EDI,1            ;bit 15 becomes sign of result
  1530.     mov    EDX,EAX
  1531.     clr    EAX            ;rest of significand is 0
  1532.     mov    ESI,31+longbias        ;2^15
  1533.     call    dnorm            ;pack result into a double
  1534.     _pop    <EDI,ESI>
  1535.     ret
  1536. c_endp    _LNGDBL@
  1537.  
  1538. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1539. ; Convert double to unsigned.
  1540.       MinBitShift =  0
  1541.        stackSize  =  MinBitShift + 4
  1542.  
  1543.  
  1544.     _align
  1545. func    _DBLUNS@
  1546.     push    EBP
  1547.     sub    ESP,stackSize
  1548.     mov    EBP,ESP
  1549.     mov    word ptr MinBitShift[EBP],15
  1550.     test    EDX,sgn
  1551.     jz    dblIntgl
  1552.  
  1553.     or    __fe_cur_env.status,FE_INVALID
  1554.     add    ESP,stackSize
  1555.     pop    EBP
  1556.     ret
  1557. c_endp    _DBLUNS@
  1558.  
  1559. ; Convert double to int.
  1560.  
  1561. func    _DBLINT@
  1562.     push    EBP
  1563.     sub    ESP,stackSize
  1564.     mov    EBP,ESP
  1565.     mov    word ptr MinBitShift[EBP],14
  1566.     test    EDX,sgn
  1567.     je    dblIntgl
  1568.  
  1569.     inc    word ptr MinBitShift[EBP]
  1570.     jmps    dblIntgl
  1571. c_endp    _DBLINT@
  1572.  
  1573.  
  1574. ; Convert double to unsigned long.
  1575.  
  1576. func    _DBLULNG@
  1577.     push    EBP
  1578.     sub    ESP,stackSize
  1579.     mov    EBP,ESP
  1580.     mov    word ptr MinBitShift[EBP],31
  1581.     test    EDX,sgn
  1582.     jz    dblIntgl
  1583.  
  1584.     or    __fe_cur_env.status,FE_INVALID
  1585.     add    ESP,stackSize
  1586.     pop    EBP
  1587.     ret
  1588. c_endp    _DBLULNG@
  1589.  
  1590. ; Convert double to long
  1591.  
  1592. func    _DBLLNG@
  1593.     push    EBP
  1594.     sub    ESP,stackSize
  1595.     mov    EBP,ESP
  1596.     mov    word ptr MinBitShift[EBP],30
  1597.     test    EDX,sgn
  1598.     jz    dblIntgl
  1599.  
  1600.     inc    word ptr MinBitShift[EBP]
  1601.  
  1602. dblIntgl:
  1603.     _push    <ESI,EDI,EBX,ECX>
  1604.     call    dget_dtype
  1605.     shl    ESI,2
  1606.     jmp    dword ptr cs:dblIntglIndex[ESI]
  1607.  
  1608. dblIntglIndex label      word
  1609.     dd    dblIntglNormal          ;other
  1610.     dd    dblIntglZero          ;zero
  1611.     dd    dblIntglInvalid          ;infinite
  1612.     dd    dblIntglInvalid          ;SNaN
  1613.     dd    dblIntglInvalid          ;QNaN
  1614.  
  1615. dblIntglNormal:
  1616.     call    dunnorm            ;unpack double
  1617.     clr    EBX
  1618.     sub    SI,longbias       ;un-bias the exponent
  1619.     js    dblIntgl4        ;for neg exponents, the result is 0
  1620.     _ifs    SI a MinBitShift[EBP], dblIntglInvalid
  1621.     shld    EBX,EAX,8        ;capture sticky bit and guard bits
  1622.     or    AH,AL
  1623.     or    BL,AH
  1624.     mov    EAX,EDX
  1625.     mov    ECX,31
  1626.     sub    CX,SI
  1627.     jcxz    dblIntgl2
  1628.  
  1629.     _align
  1630. dblIntgl3:
  1631.     shr    EAX,1
  1632.     rcr    BH,1            ;keep stick bit
  1633.     adc    BL,0            ;keep gaurd bit
  1634.     loop    dblIntgl3
  1635.  
  1636. dblIntgl2:
  1637.     mov    ESI,MinBitShift[EBP]
  1638.     tst    BX
  1639.     je    dblIntgl6
  1640.     or    __fe_cur_env.status,FE_INEXACT    ;no longer exact
  1641. dblIntgl6:
  1642.     test    EDI,sgn            ;is result negative?
  1643.     js    dblIntgl8
  1644.     jmps    dblIntglDone        ;no
  1645.  
  1646.  
  1647. dblIntgl4:
  1648.     mov    BL,1        ;save stick bits
  1649.     cmp    SI,-1        ;is guard bit needed
  1650.     je    dblIntgl5
  1651.     or    BH,80h        ;make guard bit into sticky bit
  1652. dblIntgl5:
  1653.     clr    EAX
  1654.     jmps    dblIntgl2
  1655. dblIntglInexact:
  1656.     or    __fe_cur_env.status,FE_INEXACT    ;no longer exact
  1657. dblIntglZero:
  1658.     clr    EAX         ;result is 0
  1659.     jmps   dblIntglDone
  1660.  
  1661. dblIntglInvalid:
  1662.     or    __fe_cur_env.status,FE_INVALID
  1663.  
  1664. dblIntglDone:
  1665.     _pop    <ECX,EBX,EDI,ESI>
  1666.     add    ESP,stackSize
  1667.     pop    EBP
  1668.     ret
  1669.  
  1670. dblIntgl8:
  1671.     mov    EDI,80000000h
  1672.     mov    SI,MinBitShift[EBP]
  1673.     _ifs    SI e 31, dblIntgl7
  1674.     
  1675.     mov    EDI,8000h
  1676.     
  1677.  
  1678. dblIntgl7:
  1679.     cmp    EAX,EDI
  1680.     je        dblIntglDone
  1681.     ja    dblIntglInvalid
  1682.  
  1683.     neg    EAX            ;yes
  1684.     jmps    dblIntglDone
  1685. c_endp    _DBLLNG@
  1686. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1687. ; float
  1688. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1689. ; Unpack a float. The float must not be 0.
  1690. ; Input:
  1691. ;    [EAX] = the float (with sign = 0)
  1692. ; Output:
  1693. ;    [EAX] = significand (with hidden bit in DX bit 15)
  1694. ;    SI    exponent
  1695. ;    EDI    sign (in bit 15)
  1696.  
  1697. public    funnorm
  1698. funnorm proc    near
  1699.     mov    EDI,EAX          ;save sign
  1700.     test    EDI,shortexp
  1701.     jne    funnorm1
  1702.     clr    ESI
  1703.     call    fleft_justify
  1704.     jmps    funnorm2
  1705.  
  1706. funnorm1:
  1707.     mov    ESI,EAX
  1708.     and    ESI,sgn_mask
  1709.     shr    ESI,16+7
  1710.     or    EAX,shorthid     ;or in hidden bit (80h)
  1711.  
  1712. funnorm2:
  1713.     shl    EAX,8
  1714.     ret
  1715. funnorm endp
  1716.  
  1717. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1718. ; Normalize and pack a float.
  1719. ; Input:
  1720. ;    [EAX] = significand
  1721. ;    SI = exponent (biased)
  1722. ;    EDI bit 31 = sign of result
  1723. ;
  1724. public    fnorm
  1725. fnorm    proc    near
  1726.     sub    SI,8        ;offset
  1727.  
  1728. fnorm2:
  1729.     test    EAX,7f000000h    ;do we need to shift right?
  1730.     jz    fnorm3        ;no
  1731.  
  1732. fnorm1:
  1733.     shr    EAX,1
  1734.     inc    SI        ;exponent
  1735.     jnc    fnorm2        ;no rounding
  1736.     test    EAX,7f000000h    ;done shifting?
  1737.     jnz    fnorm1        ;no
  1738.  
  1739.  
  1740. ;see if our significand is 0
  1741. fnorm3:
  1742.     tst    EAX
  1743.     jnz    fnorm4
  1744.     mov    EAX,shorthid
  1745.     clr    SI        ;trick fnorm4 into giving us a 0 result
  1746.  
  1747. fnorm4:
  1748.     test    EAX,shorthid     ;hidden bit in right spot?
  1749.     jnz    fnorm5        ;yes
  1750.     shl    EAX,1         ;shift left till it is
  1751.     dec    SI
  1752.     jmp    fnorm4
  1753.  
  1754. fnorm5:
  1755.     _ifs SI ge 0, fpack
  1756.     shl    EAX,7
  1757.     dec    SI
  1758.     call    fright_justify
  1759.     jmp    fround7
  1760. fnorm    endp
  1761.  
  1762. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1763. ; Pack a float.
  1764. ; Input:
  1765. ;    [EAX] = significand
  1766. ;    SI = exponent (biased)
  1767. ;    EDI bit 31 = sign of result
  1768. ;
  1769.  
  1770. public    fpack
  1771. fpack    proc    near
  1772.     shl    ESI,16+7
  1773.     _ifs     ESI ae short_infinity, fpackOverflow
  1774.  
  1775.     and    EAX,shorthid - 1 ;dump hidden bit
  1776.     or    EAX,ESI        ;install exponent
  1777.     and    EDI,sgn        ;mask sign bit
  1778.     or    EAX,EDI         ;install sign
  1779. fpack2:    ret
  1780.  
  1781. fpackOverflow:
  1782.     or    __fe_cur_env.status,FE_OVERFLOW or FE_INEXACT
  1783.     mov    AX,2        ;overflow
  1784.     jmp    fexception    ;raise overflow exception
  1785. fpack    endp
  1786.  
  1787. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1788. ; Left justify mantissa when
  1789. ; exponent is zero
  1790. ;
  1791. ;  Input:
  1792. ; [EAX] = float
  1793. ; SI        = Exponent
  1794. ;
  1795. public fleft_justify
  1796.  
  1797. fleft_justify proc near
  1798.     mov    ESI,1
  1799.  
  1800. fleft_justify1:
  1801.     dec    SI            ;Adjust exponent
  1802.     shl    EAX,1            ;shift mantissa left
  1803.     test    EAX,shorthid        ;is it shifted enough
  1804.     je    fleft_justify1        ;no
  1805.     ret
  1806. fleft_justify endp
  1807. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1808. ; Right justifty mantissa when
  1809. ; exponent is less then zero
  1810. ;
  1811. ;  Input:
  1812. ;  [EAX]  = float
  1813. ;  SI      = Exponent
  1814. ;
  1815. public fright_justify
  1816.  
  1817. fright_justify proc near
  1818.     _ifs SI l -24, fright_justify5
  1819.  
  1820. fright_justify1:
  1821.     _ifs     SI g -8, fright_justify2
  1822.     sh32StyRBy8
  1823.     add    SI,8
  1824.     jnz    fright_justify1
  1825.  
  1826. fright_justify2:
  1827.     xchg    ECX,ESI
  1828.     and    ECX,0ffffh    ;make sure CX is clear
  1829.     jcxz    fright_justify3    ;no shifting need be done
  1830.     neg    CX
  1831.     or    AL,AL        ;If any sticky bits are set then
  1832.     je    fright_justify4    ;make sure they don't all rotate out
  1833.     or    AL,40h
  1834.  
  1835. fright_justify4:
  1836.     shr    EAX,1
  1837.     loop    fright_justify4
  1838.  
  1839. fright_justify3:
  1840.     xchg    ECX,ESI        ;restore CX, SI = 0
  1841.     ret
  1842.  
  1843. fright_justify5:
  1844.     tst    EAX
  1845.     je    fright_justify6
  1846.     mov    EAX,1
  1847.     jmps    fright_justify7
  1848.  
  1849. fright_justify6:
  1850.     clr    EAX
  1851.     
  1852. fright_justify7:
  1853.     clr    ESI
  1854.     ret
  1855. fright_justify endp
  1856.  
  1857.  
  1858. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1859. ; Round and normalize and add
  1860. ;Input:
  1861. ;    [EAX] = significand
  1862. ;    assume bit 30 or 31 of EAX is set
  1863. ;    if bit 31 is set then
  1864. ;         all of AL make up the sticky bits and bit
  1865. ;        1 in AH is the guard bit.
  1866. ;    else
  1867. ;        bit 7 of AL is the guard bit, the rest of the
  1868. ;        bits int AL make up the sticky bits and bit
  1869. ;    SI = exponent (biased)
  1870. ;    DI (sign bit)
  1871. ;
  1872. public    fround
  1873. fround    proc    near
  1874.     dec    SI        ;Make sure exponent is correct if not shifted
  1875.     test    EAX,sgn        ;if bit 8 of AH is set then
  1876.     jz    fround1        ;adjust shift register and
  1877.     shr    EAX,1
  1878.     jnc    fround12
  1879.     or    AL,1        ;make sure sticky bit dit not drop off
  1880.  
  1881. fround12:
  1882.     inc    SI        ;adjust exponent
  1883.  
  1884. fround1:
  1885.     _ifs     SI l 0ffh, fround11
  1886.     jmp    fpackOverflow
  1887.  
  1888. fround11:
  1889.     _ifs SI g 0, fround7
  1890.     dec    SI        ;adjustment so it will shift ok
  1891.     call    fright_justify    ;shift right untell SI is zero
  1892.  
  1893. fround7:
  1894.     test    AL,01000000b
  1895.     jne    fround6
  1896.     test    AL,00111111b
  1897.     je    fround5
  1898.  
  1899. fround6:
  1900.     tst    SI
  1901.     jne    fround10
  1902.     or    __fe_cur_env.status,FE_UNDERFLOW
  1903. fround10:
  1904.     or    __fe_cur_env.status,FE_INEXACT    ;no longer exact
  1905.     _ifs     __fe_cur_env.round e  FE_TONEAREST, fround3
  1906.     _ifs     __fe_cur_env.round e  FE_TOWARDZERO,fround5
  1907.     _ifs     __fe_cur_env.round ne FE_DOWNWARD,fround2
  1908.  
  1909.  
  1910.     ;FE_DOWNWARD
  1911.     test    EDI,sgn
  1912.     jns    fround5
  1913.     jmps    fround4
  1914.  
  1915.  
  1916. fround2:;FE_UPWORD
  1917.     test    EDI,sgn
  1918.     js    fround5
  1919.     jmps    fround4
  1920.  
  1921.  
  1922. fround3:;FE_TONEAREST
  1923.     test    AL,01000000b    ;If guard bit is not set then
  1924.     jz    fround5        ;no rounding is necessary
  1925.     test    AL,10111111b    ;Test if odd or sticky bits are set
  1926.     jz    fround5
  1927.  
  1928.  
  1929. fround4:;round up
  1930.     add    EAX,80h
  1931.     tst    SI        ;is exponent zero
  1932.     je    fround9        ;yes
  1933.  
  1934.     test    EAX,sgn        ;is msb still where is should be
  1935.     jz    fround5
  1936.     inc    SI
  1937.     shr    EAX,1
  1938.  
  1939. fround5:
  1940.     shr    EAX,7
  1941.     jmp    fpack
  1942.  
  1943. fround9:            ;when exponent is zero
  1944.     test    EAX,40000000h    ;is msb still where is should be
  1945.     jz    fround5        ;yes
  1946.     inc    SI        ;exponent is now 1
  1947.     jmps    fround5
  1948. fround    endp
  1949.  
  1950. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1951. ; Raise underflow/overflow exception
  1952. ; Input:
  1953. ;    DI    bit 15 is sign bit of result
  1954. ;    AX    1 = underflow
  1955. ;        2 = overflow
  1956. ; Returns:
  1957. ;    EAX   adjusted result
  1958.  
  1959. fexception proc near
  1960.     dec    EAX
  1961.     jz    fexcepToNearest           ;0 is result for underflow
  1962.     mov    EAX,shortexp
  1963.  
  1964.     ;Adjust infinity based on rounding mode
  1965.     ;NEAREST    infinity with sign
  1966.     ;DOWN        + overflows to + largest finite, - overflows to -inf
  1967.     ;UP        - overflows to - largest finite, + overflows to +inf
  1968.     ;TOZERO        to signed largest finite
  1969.  
  1970.     _ifs     __fe_cur_env.round e FE_TONEAREST, fexcepToNearest
  1971.     _ifs     __fe_cur_env.round e FE_TOWARDZERO, fexcepTowardZero
  1972.     _ifs     __fe_cur_env.round e FE_UPWARD, fexcepUpward
  1973.  
  1974.     tst    EDI
  1975.     js    fexcepToNearest
  1976.     jmps    fexcepTowardZero
  1977.  
  1978. fexcepUpward:
  1979.     tst    EDI
  1980.     jns    fexcepToNearest
  1981.  
  1982.     ;Generate largest finite
  1983. fexcepTowardZero:
  1984.     mov    EAX,07F7FFFFFh
  1985.  
  1986. fexcepToNearest:
  1987.     and    EDI,sgn
  1988.     or    EAX,EDI          ;install sign bit
  1989.     ret
  1990. fexception endp
  1991. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1992. ; get specal case index of  float
  1993. ;    index = case(a)
  1994. ; input:
  1995. ;    [EAX] = a
  1996. ; Output:
  1997. ;    SI = index
  1998. ;
  1999. public fget_dtype
  2000. fget_dtype proc near
  2001.     clr    ESI                ;set to default
  2002.     test    EAX,shortexp
  2003.     jz    fget_dtype1
  2004.  
  2005.     mov    EDI,EAX
  2006.     and    EDI,shortexp            ;mask exponent
  2007.     _ifs    EDI ne short_infinity, fget_dtype2 ;c is not NaN or infinite
  2008.     mov    EDI,EAX
  2009.     test    EDI,fqnan_bit             ;bit must be set to be
  2010.     jz    fget_dtype3                ;a quit NaN
  2011.     mov    SI,dtype_qnan                    ;c is a quite NaN
  2012.     ret
  2013.  
  2014. fget_dtype3:
  2015.     and    EDI,shorthid-1                      ;Mantissa must be zero to be infinite
  2016.     jz    fget_dtype4                ;otherwise
  2017.     mov    SI,dtype_snan                    ;c is a signaling NaN
  2018.     ret
  2019.  
  2020. fget_dtype4:                        ;c is infinite
  2021.     mov    SI,dtype_infinite
  2022.     ret
  2023.  
  2024. fget_dtype1:
  2025.     test    EAX,shorthid-1
  2026.     jnz    fget_dtype2
  2027.         mov    SI,dtype_zero                ;c is zero
  2028.  
  2029. fget_dtype2:
  2030.     ret
  2031. fget_dtype endp
  2032.  
  2033. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2034. ; Convert from float to double.
  2035. ; Input:
  2036. ;    EAX = float
  2037. ; Output:
  2038. ;    [EDX,EAX] = double
  2039.  
  2040. func    _FLTDBL@
  2041.     _ifs     __8087 e 0, fltDbl1      ;if no 8087
  2042.     sub    ESP,4             ;2 extra words
  2043.     push    EAX
  2044.     fld    dword ptr [ESP]        ;load float into 8087
  2045. fltret2:
  2046.     fstp    qword ptr [ESP]
  2047.     fwait                ;wait for it to finish
  2048.     _pop    <EAX,EDX>        ;pop result
  2049.     ret
  2050. fltDbl1:
  2051.     _push    <ESI,EDI>
  2052.     call    fget_dtype
  2053.     shl    ESI,2
  2054.     jmp    dword ptr cs:fltDblIndex[ESI]
  2055.  
  2056.  
  2057. fltDblIndex label    dword
  2058.     dd    fltDblNormal        ;other
  2059.     dd    fltDblZero        ;zero
  2060.     dd    fltDblInfinite        ;infinite
  2061.     dd    fltDblSNaN        ;SNaN
  2062.     dd    fltDblQNaN        ;QNaN
  2063.  
  2064. fltDblNormal:
  2065.         call    funnorm            ;unpack the float
  2066.     mov    EDX,EAX
  2067.     clr    EAX
  2068.     add    SI,longbias-shortbias    ;fix the bias on the exponent
  2069.     call    dround            ;pack a double
  2070.     jmps    fltDblDone
  2071.  
  2072. fltDblZero:
  2073.     clr    EDX
  2074.     jmps    fltDblSign
  2075.  
  2076. fltDblInfinite:
  2077.     mov    EDX,long_infinity
  2078.     jmps    fltDblSign
  2079.     
  2080. fltDblSNaN:
  2081.     mov    EDX,long_infinity OR 200h
  2082.     jmps    fltDblSign
  2083.  
  2084. fltDblQNaN:
  2085.     mov    EDX,long_qnan OR 040000h
  2086.     test    EAX,10000h
  2087.     je    fltDblSign
  2088.     or    EDX,0200h
  2089.  
  2090.  
  2091. fltDblSign:
  2092.     and    EAX,sgn
  2093.     or    EDX,EAX
  2094.     clr    EAX
  2095.  
  2096. fltDblDone:
  2097.     _pop    <EDI,ESI>
  2098.     ret
  2099. c_endp    _FLTDBL@
  2100.  
  2101. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2102. ; Convert from double to float.
  2103. ; Input:
  2104. ;    [EDX,EAX]
  2105. ; Output:
  2106. ;    [EAX]
  2107. ;    ECX,EBX   destroyed
  2108. ;    ESI,EDI   preserved
  2109.  
  2110. func    _DBLFLT@
  2111.  
  2112.     _ifs     __8087 e 0, dblFlt1      ;if no 8087
  2113.     _push    <EDX,EAX>        ;push double
  2114.     push    EBP
  2115.     mov    EBP,ESP
  2116.     fld    qword ptr 4[EBP]    ;load b into 8087
  2117.     fstp    dword ptr 8[EBP]    ;store float result
  2118.     pop    EBP
  2119.     add    ESP,4
  2120.     fwait                ;wait for it to finish
  2121.     pop    EAX            ;pop result
  2122.     ret
  2123.  
  2124. dblFlt1:
  2125.     _push    <ESI,EDI>
  2126.     call    dget_dtype
  2127.     shl    SI,2
  2128.     jmp    dword ptr cs:dblFltIndex[ESI]
  2129.  
  2130. dblFltIndex label    word
  2131.     dd    dblFltNormal        ;other
  2132.     dd    dblFltSign        ;zero
  2133.     dd    dblFltInfinite        ;infinite
  2134.     dd    dblFltSNaN        ;SNaN
  2135.     dd    dblFltQNaN        ;QNaN
  2136.  
  2137. dblFltNormal:
  2138.     call    dunnorm            ;unpack double
  2139.     sub    SI,longbias-shortbias    ;fix exponent bias
  2140.     tst    EAX
  2141.     jz    dblFlt4
  2142.     or    EDX,1            ;save sticky bit
  2143. dblFlt4:
  2144.     mov    EAX,EDX
  2145.     call    fround            ;pack float
  2146.     jmps    dblFltDone
  2147.  
  2148.  
  2149.  
  2150. dblFltInfinite:
  2151.     mov    EAX,short_infinity
  2152.     jmps    dblFltSign
  2153.     
  2154. dblFltSNaN:
  2155.     mov    EAX,short_infinity OR 10000h
  2156.     jmps    dblFltSign
  2157.  
  2158. dblFltQNaN:
  2159.     mov    EAX,short_qnan
  2160.     cmp    DH,02h
  2161.     jne    dblFltSign
  2162.     or    EAX,10000h
  2163.  
  2164. dblFltSign:
  2165.     and    EDX,sgn
  2166.     or    EAX,EDX
  2167.  
  2168. dblFltDone:
  2169.     _pop    <EDI,ESI>
  2170.     ret
  2171. c_endp    _DBLFLT@
  2172.  
  2173.  
  2174.  
  2175.  
  2176.     endcode    double
  2177.  
  2178.     end
  2181.