home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / mint / lib / mntc6846.zoo / patch / dfmul.s < prev    next >
Encoding:
Text File  |  1994-11-26  |  5.1 KB  |  189 lines
  1.  ! 8 byte floating point multiply routine
  2.  !-----------------------------------------------------------------------------
  3.  ! ported to 68000 by Kai-Uwe Bloem, 12/89
  4.  !  #1  original author: Peter S. Housel 4/1/89
  5.  !  #2  replace duplicated code by loop. Costs a little more time, but saves
  6.  !    a lot of code. The time loss is minor due to the durance of a mulu
  7.  !    instruction.                        -kub-, 01/90
  8.  !  #3    added support for denormalized numbers            -kub-, 01/90
  9.  !  #4  Redid register usage, and then added wrapper routine
  10.  !    to provide C68 IEEE compatibility    Dave & Keith Walker    02/92
  11.  !  #5  Changed exit code to put pointer to result in D0   Dave Walker  12/92
  12.  !-----------------------------------------------------------------------------
  13.  
  14. SAVEREG    =    6*4        ! size of saved registers on stack
  15. BIAS8    =    0x3FF - 1
  16.  
  17.     .sect .text
  18.  
  19.     .define .Xdfmul
  20.     .define .Xasdfmul
  21.  
  22. !----------------------------------------
  23. !    sp    Return address
  24. !    sp+4    address of result
  25. !    sp+8    address of multiplicand
  26. !    sp+12    address of multiplier
  27. !----------------------------------------
  28.  
  29. .Xdfmul:
  30.     movem.l    d2-d7,-(sp)        ! save registers
  31.     move.l    SAVEREG+12(sp),a1    ! address of u
  32.     movem.l    (a1),d4-d5        ! load u
  33.     move.l    SAVEREG+8(sp),a1    ! address of v
  34.     movem.l    (a1),d6-d7        ! load v
  35.     move.l    SAVEREG+4(sp),a1    ! result address
  36.     bsr    dfmultiply        ! do operation
  37.     movem.l    (sp)+,d2-d7        ! restore saved registers
  38.  
  39.     move.l    (sp)+,a1        ! get return address
  40.     lea    12(sp),sp        ! remove 3 parameters from stack
  41.     jmp    (a1)            ! ... and return
  42.  
  43. !----------------------------------------
  44. !    sp    Return address
  45. !    sp+4    address of result/multiplicand
  46. !    sp+8    address of multiplier
  47. !----------------------------------------
  48. .Xasdfmul:
  49.     movem.l    d2-d7,-(sp)        ! save registers
  50.     move.l    SAVEREG+8(sp),a1    ! address of u
  51.     movem.l    (a1),d4-d5        ! load u
  52.     move.l    SAVEREG+4(sp),a1    ! address of v / address of result
  53.     movem.l    (a1),d6-d7        ! load v
  54.     bsr    dfmultiply
  55.     movem.l    (sp)+,d2-d7        ! restore saved registers
  56.  
  57.     move.l    (sp)+,a1        ! get return address
  58.     move.l    (sp),d0            ! address of v returned as result
  59.     addq.l    #8,sp            ! remove 2 parameters from stack
  60.     jmp    (a1)            ! ... and return
  61.  
  62.  !-------------------------------------------------------------------------
  63.  ! This is the routine that actually carries out the operation.
  64.  !
  65.  ! Register usage:
  66.  !
  67.  !        Entry                Exit
  68.  !
  69.  !    d0    ?                undefined
  70.  !    d1    ?                undefined
  71.  !    d2    ?                undefined
  72.  !    d3    ?                undefined
  73.  !    d4-d5    v                undefined
  74.  !    d6-d7    u                undefined
  75.  !
  76.  !    A1    Address for result        preserved
  77.  !
  78.  !-----------------------------------------------------------------------------
  79.  
  80. dfmultiply:
  81.     move.l    d6,d0        ! d0 = u.exp
  82.     swap    d0
  83.     move.w    d0,d2        ! d2 = u.sign
  84.  
  85.     move.l    d4,d1        ! d1 = v.exp
  86.     swap    d1
  87.     eor.w    d1,d2        ! d2 = u.sign ^ v.sign (in bit 31)
  88.  
  89.     and.l    #0x0fffff,d6    ! remove exponent from u.mantissa
  90.     lsr.w    #4,d0
  91.     and.w    #0x07ff,d0    ! kill sign bit
  92.     beq    0f        ! check for zero exponent - no leading "1"
  93.     or.l    #0x100000,d6    ! restore implied leading "1"
  94.     bra    1f
  95. 0:    add.w    #1,d0        ! "normalize" exponent
  96. 1:    move.l    d6,d3
  97.     or.l    d7,d3
  98.     beq    retz        ! multiplying by zero
  99.  
  100.     and.l    #0x0fffff,d4    ! remove exponent from v.mantissa
  101.     lsr.w    #4,d1
  102.     and.w    #0x07ff,d1    ! kill sign bit
  103.     beq    0f        ! check for zero exponent - no leading "1"
  104.     or.l    #0x100000,d4    ! restore implied leading "1"
  105.     bra    1f
  106. 0:    add.w    #1,d1        ! "normalize" exponent
  107. 1:    move.l    d4,d3
  108.     or.l    d5,d3
  109.     beq    retz        ! multiplying by zero
  110.  
  111.     add.w    d1,d0        ! add exponents,
  112.     sub.w    #BIAS8+5,d0    ! remove excess bias, acnt for repositioning
  113.  
  114. !    Now do a 64bit x 64bit multiply to get a 128 bit result
  115. ! see Knuth, Seminumerical Algorithms, section 4.3. algorithm M
  116.  
  117.     sub.l    #16,sp        ! reserve space on stack
  118.     clr.l    (sp)        ! initialize 128-bit product to zero
  119.     clr.l    4(sp)
  120.     clr.l    8(sp)
  121.     clr.l    12(sp)
  122.     lea    8(sp),a0    ! address of 2nd half
  123.  
  124.     swap    d2
  125.     move.w    #4-1,d2
  126. 1:
  127.     move.w    d5,d3
  128.     mulu    d7,d3        ! multiply with digit from multiplier
  129.     add.l    d3,4(a0)    ! store into result
  130.     move.w    d4,d3
  131.     mulu    d7,d3
  132.     move.l    (a0),d1        ! add to result
  133.     addx.l    d3,d1
  134.     move.l    d1,(a0)
  135.     roxl    -(a0)        ! rotate carry in
  136.  
  137.     move.l    d5,d3
  138.     swap    d3
  139.     mulu    d7,d3
  140.     add.l    d3,4(a0)    ! add to result
  141.     move.l    d4,d3
  142.     swap    d3
  143.     mulu    d7,d3
  144.     move.l    (a0),d1        ! add to result
  145.     addx.l    d3,d1
  146.     move.l    d1,(a0)
  147.  
  148.     move.w    d6,d7
  149.     swap    d6
  150.     swap    d7
  151.     dbra    d2,1b
  152.  
  153. !    add.w    #8,a0        ! [TOP 16 BITS SHOULD BE ZERO !]
  154.     swap    d2
  155.  
  156.     movem.l    2(sp),d4-d7    ! get the 112 valid bits
  157.     clr.w    d7        ! (pad to 128)
  158. 2:
  159.     cmp.l    #0x0000ffff,d4    ! multiply (shift) until
  160.     bhi    3f        !  1 in upper 16 result bits
  161.     cmp.w    #9,d0        ! give up for denormalized numbers
  162.     ble    3f
  163.     swap    d4        ! (we are getting here only when multiplying
  164.     swap    d5        !  with a denormalized number; there is an
  165.     swap    d6        !  eventual loss of 4 bits in the rounding
  166.     swap    d7        !  byte -- what a pity 8-)
  167.     move.w    d5,d4
  168.     move.w    d6,d5
  169.     move.w    d7,d6
  170.     clr.w    d7
  171.     sub.w    #16,d0        ! decrement exponent
  172.     bra    2b
  173. 3:
  174.     move.l    d6,d1        ! get rounding bits
  175.     rol.l    #8,d1
  176.     move.l    d1,d3        ! see if sticky bit should be set
  177.     or.l    d7,d3        ! (lower 16 bits of d7 are guaranteed to be 0)
  178.     and.l    #0xffffff00,d3
  179.     beq    4f
  180.     or.b    #1,d1        ! set "sticky bit" if any low-order set
  181. 4:
  182.     lea    16(sp),sp    ! remove stack workspace
  183.     movem.l    d4/d5,(a1)    ! save result
  184.     jmp    .Xnorm8        ! exit via normalise routine
  185.  
  186. retz:    clr.l    (a1)        ! save zero as result
  187.     clr.l    4(a1)
  188.     rts             ! no normalization needed
  189.