home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / mint / lib / mntc6846.zoo / patch / ldexp.spp < prev    next >
Encoding:
Text File  |  1995-01-16  |  2.1 KB  |  88 lines
  1. ! C68 add exponent to 8 byte floating point number
  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    added support for denormalized numbers            -kub-, 01/90
  6. !  #3  Added use of limits.h to allow for both 16 and 32 bit
  7. !    int implementations
  8. !    Added check for NaN error case                -djw-    09/93
  9. !-----------------------------------------------------------------------------
  10. !  double ldexp (double x, int n)
  11. !
  12. !  The function|ldexp(double x, int n)| returns x*(2**n)
  13. !
  14. !  If underflow occurs, then errno is set to ERANGE, and zero returned
  15. !
  16. !  If overflow occurs, then errno is set to ERANGE, and +/- HUGE_VAL
  17. !  is returned
  18. !
  19. !  If |x| is a NaN then errno is set to EDOM and Nan returned.
  20. !----------------------------------------------------------------------------
  21.  
  22.     .sect .text
  23.  
  24.     .define _ldexp
  25.  
  26.     .extern    _errno
  27.     .extern __huge_val
  28.  
  29. #include <errno.h>
  30.  
  31. #ifdef __MSHORT__
  32. #define LN    w
  33. #else
  34. #define LN    l
  35. #endif
  36.  
  37. _ldexp:
  38.     lea    4(sp),a1
  39. #ifndef __MSHORT__
  40.     moveq    #0,d0
  41. #endif
  42.     move.w    (a1),d0        ! extract value.exp
  43.     move.w    d0,d2        ! extract value.sign
  44.     lsr.w    #4,d0
  45.     and.w    #0x7ff,d0    ! kill sign bit
  46.  
  47.     cmp.w    #0x7ff,d0    ! NaN ?
  48.     beq    NaNval        ! ... YES 
  49.  
  50.     and.w    #0x0f,(a1)    ! remove exponent from value.mantissa
  51.     tst.w    d0        ! check for zero exponent - no leading "1"
  52.     beq    0f
  53.     or.w    #0x10,(a1)    ! restore implied leading "1"
  54.     bra    1f
  55. 0:    add.w    #1,d0
  56. 1:
  57.     add.LN    8(a1),d0    ! add in exponent
  58.     cmp.w    #-53,d0        ! hmm. works only if 1 in implied position...
  59.     ble    retz        ! range error - underflow
  60.     cmp.w    #2047,d0
  61.     bge    rangerr        ! range error - overflow
  62.  
  63.     clr.w    d1        ! zero rounding bits
  64.     jsr    .Xnorm8
  65. retval:
  66.     movem.l    4(sp),d0-d1    ! return value
  67.     rts
  68.  
  69. NaNval:
  70.     move.LN    #EDOM,_errno    ! set error code
  71.     bra    retval        ! exit returning oringinal value
  72.  
  73. retz:
  74.     move.l    #0,d0        ! set reply to zero
  75.     move.l    #0,d1
  76.     bra    erange        ! exit setting errno
  77.  
  78. rangerr:
  79.     move.l    __huge_val,d0
  80.     move.l    __huge_val+4,d1
  81.     and.w    #0x8000,d2    ! get sign bit of argument
  82.     lsl.l    #8,d2        ! get into correct position
  83.     lsl.l    #8,d2
  84.     or.l    d2,d0        ! set sign bit if needed
  85. erange:
  86.     move.LN    #ERANGE,_errno
  87.     rts
  88.