home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #26 / NN_1992_26.iso / spool / comp / lang / lisp / mcl / 1557 < prev    next >
Encoding:
Text File  |  1992-11-07  |  3.5 KB  |  99 lines
  1. Path: sparky!uunet!pmafire!mica.inel.gov!ux1!news.byu.edu!hamblin.math.byu.edu!sol.ctr.columbia.edu!usc!elroy.jpl.nasa.gov!ames!data.nas.nasa.gov!taligent!apple!cambridge.apple.com!bill@cambridge.apple.com
  2. From: bill@cambridge.apple.com (Bill St. Clair)
  3. Newsgroups: comp.lang.lisp.mcl
  4. Subject: Re: Double floats
  5. Message-ID: <9211061649.AA27464@cambridge.apple.com>
  6. Date: 6 Nov 92 17:53:18 GMT
  7. Sender: info-mcl-request@cambridge.apple.com
  8. Lines: 85
  9. Approved: comp.lang.lisp.mcl@Cambridge.Apple.C0M
  10. Full-Name: Bill St. Clair
  11. Original-To: millett@sbctri.sbc.com
  12. Original-Cc: info-mcl
  13.  
  14. >I am tring to take a double-float number, break it down into 2 long
  15. >integers (high-word and low-word) to send over the network conforming to
  16. >the IEEE floating point standard.  I also want to read 2 words from the
  17. >stream and make a double-float from them.  Any Ideas?  Symbolics has two
  18. >functions that do what I want: "si:dfloat-components: (double)" &
  19. >"si:%make-double: (high low)"  Any way to do this with the mac?
  20. >
  21. >Thanks,
  22. >millett@sbctri.sbc.com
  23.  
  24. MCL has a function that breaks a double float into 4 fixnums:
  25. high-mantissa, low-mantissa, exponent, and sign.
  26. It also has a function for putting these components back together again.
  27.  
  28. ccl::fixnum-decode-float double-float
  29. ; decompose a double-float into fixnum size pieces
  30. ; returns 4 values
  31. ; hi is high 24 bits of mantissa (with the implied 1 in bit 25 if appropriate)
  32. ; lo is low 28 bits of mantissa  (hi and lo are both right justified)
  33. ; exp is 11 bit exponent (the bits as they are - not unbiased; i.e. exp is >= 0)
  34. ; sign is 1 or -1 
  35.  
  36. ccl::make-float-from-fixnums hi lo exp sign
  37. ; make a float from hi - high 24 bits mantissa (ignore implied higher bit)
  38. ;                   lo -  low 28 bits mantissa
  39. ;                   exp  - take low 11 bits
  40. ;                   sign - sign(sign) => result
  41. ; hi result - 1 bit sign: 11 bits exp: 20 hi bits of hi arg
  42. ; lo result - 4 lo bits of hi arg: 28 lo bits of lo arg
  43. ; no error checks, no tweaks, no nuthin
  44.  
  45. You can use these to make the integers (likely bignums) that you want:
  46.  
  47. (defun dfloat-components (dfloat)
  48.   (multiple-value-bind (hi lo exp sign) (ccl::fixnum-decode-float dfloat)
  49.     (declare (fixnum hi lo exp sign))
  50.     (values
  51.      (+ (if (< sign 0) (ash 1 31) 0)
  52.         (ash exp (- 31 11))
  53.         (ash (logand hi #xfffff0) (- 20 24)))
  54.      (+ (ash (logand hi #xf) (- 32 4))
  55.         lo))))
  56.  
  57. (defun make-double (high low)
  58.   (ccl::make-float-from-fixnums
  59.    (+ (ash (logand high #xfffff) 4)
  60.       (ash low -28))
  61.    (logand low #xfffffff)
  62.    (logand (ash high -20) #x7ff)
  63.    (if (logbitp 31 high) -1 1)))
  64.  
  65. This is not very efficient.
  66. The following LAP versions are more efficient
  67. (though dfloat-components still conses bignums):
  68.  
  69. (in-package :ccl)
  70.  
  71. (eval-when (:compile-toplevel :execute)
  72.   (require "LAPMACROS")                 ; lap-inline
  73.   (require "LISPEQU"))                  ; $floathi
  74.  
  75. (defun dfloat-components (dfloat)
  76.   (setq dfloat (require-type dfloat 'double-float))
  77.   (let (hi lo)
  78.     (lap-inline ()
  79.       (:variable dfloat hi lo)
  80.       (move.l (varg dfloat) atemp0)
  81.       (move.l (atemp0 $floathi) arg_z)
  82.       (jsr_subprim $sp-mklong)
  83.       (move.l acc (varg hi))
  84.       (move.l (varg dfloat) atemp0)
  85.       (move.l (atemp0 (+ $floathi 4)) arg_z)
  86.       (jsr_subprim $sp-mklong)
  87.       (move.l acc (varg lo)))
  88.     (values hi lo)))
  89.       
  90. (defun make-float (high low)
  91.   (lap-inline ()
  92.     (:variable high low)
  93.     (move.l (varg high) arg_z)
  94.     (jsr_subprim $sp-getxlong)
  95.     (move.l acc arg_y)
  96.     (move.l (varg low) arg_z)
  97.     (jsr_subprim $sp-getxlong)
  98.     (jsr_subprim $sp-makefloat)))
  99.