home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / mint / lib / mntc6846.zoo / patch / sfmul.s < prev    next >
Encoding:
Text File  |  1994-11-26  |  4.8 KB  |  167 lines

  1.  ! C68 4 byte floating point multiply routine
  2.  !-----------------------------------------------------------------------------
  3.  !  Based on _dfmul.s
  4.  !
  5.  !  #1  Redid register usage, and then added wrapper routine
  6.  !    to provide C68 IEEE compatibility    Dave & Keith Walker    02/92
  7.  !  #2  Corrected problem with corrupting D7.  Redid register
  8.  !    useage to slightly increase effeciency.  Dave Walker        09/92
  9.  !  #3  Changed exit code to put pointer to result in D0   Dave Walker  12/92
  10.  !  #4  Changed entry/exit code for C68 v4.3 compatibility.
  11.  !    Removed ACK entry points                -djw-    09/93
  12.  !-----------------------------------------------------------------------------
  13.  
  14. SAVEREG    =    5*4        ! size of saved registers ons tack
  15. BIAS4    =    0x7F - 1
  16.  
  17.     .sect .text
  18.  
  19.     .define .Xsfmul
  20.     .define .Xassfmul
  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. .Xsfmul:
  29.     movem.l    d2-d6,-(sp)        ! save registers
  30.     move.l    SAVEREG+12(sp),a1    ! address of u
  31.     move.l    (a1),d4            ! load v
  32.     move.l    SAVEREG+8(sp),a1    ! address of v
  33.     move.l    (a1),d6            ! load u
  34.     move.l    SAVEREG+4(sp),a1    ! result address
  35.     bsr    sfmultiply        ! do operation
  36.     movem.l    (sp)+,d2-d6        ! restore saved registers
  37.  
  38.     move.l    (sp)+,a0        ! get return address
  39.     lea    12(sp),sp        ! remove 3 parameters from stack
  40.     jmp    (a0)            ! ... and return
  41.  
  42. !----------------------------------------
  43. !    sp    Return address
  44. !    sp+4    address of result/multiplicand
  45. !    sp+8    address of multiplier
  46. !----------------------------------------
  47. .Xassfmul:
  48.     movem.l    d2-d6,-(sp)        ! save registers
  49.     move.l    SAVEREG+8(sp),a1    ! address of u
  50.     move.l    (a1),d4            ! load v
  51.     move.l    SAVEREG+4(sp),a1    ! address of v
  52.     move.l    (a1),d6            ! load u
  53.     bsr    sfmultiply
  54.     movem.l    (sp)+,d2-d6        ! restore saved registers
  55.  
  56.     move.l    (sp)+,a1        ! get return address
  57.     move.l    (sp),d0            ! address of v returned as result
  58.     addq.l    #8,sp            ! remove 2 parameters from stack
  59.     jmp    (a1)            ! ... and return
  60.  
  61.  !-------------------------------------------------------------------------
  62.  ! This is the routine that actually carries out the operation.
  63.  !
  64.  ! Register usage:
  65.  !
  66.  !        Entry                Exit
  67.  !
  68.  !    d0    ?                undefined
  69.  !    d1    ?                undefined
  70.  !    d2    ?                undefined
  71.  !    d3    ?                undefined
  72.  !    d4    v (multiplicand)        undefined
  73.  !    d5    ?                undefined
  74.  !    d6    u (multiplier)            undefined
  75.  !
  76.  !    A1    Address for result        preserved
  77.  !
  78.  !-----------------------------------------------------------------------------
  79.  
  80. sfmultiply:
  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    #0x07fffff,d6    ! remove exponent from u.mantissa
  90.     lsr.w    #7,d0
  91.     and.w    #0x0ff,d0    ! kill sign bit
  92.     beq    0f        ! check for zero exponent - no leading "1"
  93.     or.l    #0x800000,d6    ! restore implied leading "1"
  94.     bra    1f
  95. 0:    add.w    #1,d0        ! "normalize" exponent
  96. 1:    tst.l    d6        ! multiplying by zero ?
  97.     beq    retz        ! ... yes - special case - take fast route
  98.  
  99.     and.l    #0x07fffff,d4    ! remove exponent from v.mantissa
  100.     lsr.w    #7,d1
  101.     and.w    #0x0ff,d1    ! kill sign bit
  102.     beq    0f        ! check for zero exponent - no leading "1"
  103.     or.l    #0x800000,d4    ! restore implied leading "1"
  104.     bra    1f
  105. 0:    add.w    #1,d1        ! "normalize" exponent
  106. 1:    tst.l    d4        ! multiplying by zero ?
  107.     beq    retz        ! ... yes - special case - take fast route
  108.  
  109.     add.w    d1,d0        ! add exponents,
  110.     sub.w    #BIAS4+8,d0    ! remove excess bias, acnt for repositioning
  111.  
  112. !     Now do a 32bit x 32bit multiply to get a 64 bit result
  113. !    see Knuth, Seminumerical Algorithms, section 4.3. algorithm M
  114.  
  115.     sub.l    #8,sp        ! reserve space on stack
  116.     clr.l    (sp)        ! initialize 64-bit product to zero
  117.     clr.l    4(sp)
  118.     lea    4(sp),a0    ! address of 2nd half
  119.     move.w    #2-1,d5
  120. 1:
  121.     move.w    d4,d3
  122.     mulu    d6,d3        ! multiply with digit from multiplier
  123.     move.l    (a0),d1        ! add to result
  124.     addx.l    d3,d1
  125.     move.l    d1,(a0)
  126.     roxl    -(a0)        ! rotate carry in
  127.  
  128.     move.l    d4,d3
  129.     swap    d3
  130.     mulu    d6,d3
  131.     move.l    (a0),d1        ! add to result
  132.     addx.l    d3,d1
  133.     move.l    d1,(a0)
  134.  
  135.     swap    d6        ! get next 16 bits of multiplier
  136.     dbra    d5,1b
  137.  
  138. !    The next bit of code does a coarse normalisation to ensure that
  139. !    we have enough bits to complete it in the .norm4 routine.
  140.  
  141.     movem.l    2(sp),d4/d5    ! get the 64 valid bits
  142. 2:
  143.     cmp.l    #0x007fffff,d4    ! multiply (shift) until
  144.     bhi    3f        !  1 in upper result bits
  145.     cmp.w    #9,d0        ! give up for denormalized numbers
  146.     ble    3f
  147.     lsl.l    #8,d4        ! else rotate up by 8 bits
  148.     rol.l    #8,d5        ! get 8 bits from d6
  149.     move.b    d5,d4        ! ... and insert into space
  150.     clr.b    d5        ! ... and then remove bits from running result
  151.     sub.w    #8,d0        ! reduce exponent
  152.     bra    2b        ! try again
  153. 3:
  154.     move.l    d5,d1
  155.     rol.l    #8,d1
  156.     move.l    d1,d3        ! see if sticky bit should be set
  157.     and.l    #0xffffff00,d3
  158.     beq    5f
  159.     or.b    #1,d1        ! set "sticky bit" if any low-order set
  160. 5:
  161.     addq.l    #8,sp        ! remove stack workspace
  162.     move.l    d4,(a1)        ! save result
  163.     jmp    .Xnorm4        ! exit via normalisation routine
  164.  
  165. retz:    clr.l    (a1)        ! save zero as result
  166.     rts             ! no normalization needed
  167.