home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / mint / lib / mntc6846.zoo / patch / modf.spp < prev    next >
Encoding:
Text File  |  1994-11-14  |  3.1 KB  |  116 lines
  1. ! C68: split 'double' number into integer and fractional pieces
  2. !-----------------------------------------------------------------------------
  3. ! ported to 68000 by Kai-Uwe Bloem, 12/89
  4. !  #1  original author: Peter S. Housel 9/21/88,01/17/89,03/19/89,5/24/89
  5. !  #2  replaced shifts by swap if possible for speed increase    -kub-, 01/90
  6. !  #3  Added use of limits.h to allow for both 16 and 32 bit ints.
  7. !    Added check for NaN input                -djw-  09/93
  8. !-----------------------------------------------------------------------------
  9. !  double modf (double x, double * nptr)
  10. !
  11. !  The function |modf()| splits a double precision floating point number
  12. !  into a fractional part |f| and an integer part |n|, such that the
  13. !  absolute value of |f| is less than 1.0 and such that |f| plus |n| is
  14. !  equal to |x|.  Both |f| and |n| will have the same sign as the input
  15. !  argument.  The fractional part |f| is returned, and as a side effect
  16. !  the integer part |n| is stored into the place pointed to by |nptr|.
  17. !
  18. !  If |x| is a NaN, then errno is set to EDOM, and a NaN returned.
  19. !-----------------------------------------------------------------------------
  20.  
  21. BIAS8    =    0x3ff - 1
  22.  
  23.     .sect .text
  24.  
  25.     .define    _modf
  26.     .extern    _errno
  27.  
  28. #include <errno.h>
  29. #ifdef __MSHORT__
  30. #define LN    w
  31. #else
  32. #define LN    l
  33. #endif
  34.  
  35. _modf:
  36.     lea    4(sp),a0    ! a0 -> double argument
  37.     move.l    12(sp),a1    ! a1 -> ipart result
  38.  
  39.     move.w    (a0),d0        ! extract value.exp
  40.     move.w    d0,d2        ! extract value.sign
  41.     lsr.w    #4,d0
  42.     and.w    #0x7ff,d0    ! kill sign bit
  43.  
  44.     cmp.w    #0x7ff,d0    ! NaN ?
  45.     beq    NaNval        ! ... YES, then errore exit
  46.  
  47.     cmp.w    #BIAS8,d0
  48.     bge    1f        ! fabs(value) >= 1.0
  49.  
  50.     clr.l    (a1)        ! store zero as the integer part
  51.     clr.l    4(a1)
  52. retval:
  53.     movem.l    (a0),d0-d1    ! return entire value as fractional part
  54.     rts
  55. NaNval:
  56.     move.LN    #EDOM,_errno    ! set errno value
  57.     bra    retval        ! exit returning original NaN value
  58.  
  59. 1:
  60.     cmp.w    #BIAS8+53,d0    ! all integer, with no fractional part ?
  61.     blt    2f        ! no, mixed
  62.  
  63.     move.l    (a0),(a1)    ! store entire value as the integer part
  64.     move.l    4(a0),4(a1)
  65.     clr.l    d0        ! return zero as fractional part
  66.     clr.l    d1
  67.     rts
  68. 2:
  69.     movem.l    d4-d7,-(sp)    ! save some registers
  70.     movem.l    (a0),d4-d5    ! get value
  71.  
  72.     and.l    #0x0fffff,d4    ! remove exponent from value.mantissa
  73.     or.l    #0x100000,d4    ! restore implied leading "1"
  74.  
  75.     clr.l    d6        ! zero fractional part
  76.     clr.l    d7
  77. 3:
  78.     cmp.w    #BIAS8+37,d0    ! fast shift, 16 bits ?
  79.     bgt    5f
  80.     move.w    d6,d7        ! shift down 16 bits
  81.     move.w    d5,d6
  82.     move.w    d4,d5
  83.     clr.w    d4
  84.     swap    d7
  85.     swap    d6
  86.     swap    d5
  87.     swap    d4
  88.     add.w    #16,d0
  89.     bra    3b
  90. 4:
  91.     lsr.l    #1,d4        ! shift integer part
  92.     roxr.l    #1,d5
  93.  
  94.     roxr.l    #1,d6        ! shift high bit into fractional part
  95.     roxr.l    #1,d7
  96.  
  97.     add.w    #1,d0        ! increment ipart exponent
  98. 5:
  99.     cmp.w    #BIAS8+53,d0    ! done ?
  100.     blt    4b        ! keep shifting
  101.     movem.l    d4-d5,(a1)    ! save ipart
  102.     movem.l    d6-d7,(a0)    ! save frac part
  103.     movem.l    (sp)+,d4-d7    ! get registers back
  104.  
  105.     movem.l    d2/a0,-(sp)    ! save address and sign of frac part
  106.     clr.w    d1        ! clear rounding bits
  107.     jsr    .Xnorm8        ! renormalize integer part
  108.  
  109.     movem.l    (sp)+,d2/a1    ! get address and sign back
  110.     clr.w    d1        ! clear rounding bits
  111.     move.w    #BIAS8-11,d0    ! set frac part exponent
  112.     jsr    .Xnorm8        ! renormalize fractional part
  113.  
  114.     movem.l    4(sp),d0-d1    ! return fract part
  115.     rts
  116.