Mercurial > core / lisp/std/num/float.lisp
changeset 548: |
b57066450cfa |
parent: |
ec1d4d544c36
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Mon, 15 Jul 2024 20:59:04 -0400 |
permissions: |
-rw-r--r-- |
description: |
init tcompact encoders |
1 ;;; std/num/float.lisp --- Floating Point Numbers 3 ;; IEEE 754 Floating Point encoding and decoding. 7 ;; This package provides default encoders for float32 and float64 as defined 10 ;; Note that the physical encoding is always represented as a fixnum. 12 ;; To read/write from a file you must pass through a fixnum repr to bytes, 13 ;; usually using octets-to-integer or integer-to-octets. 17 ;;; Functions for converting floating point numbers represented in 18 ;;; IEEE 754 style to lisp numbers. 20 ;;; See http://common-lisp.net/project/ieee-floats/ 23 (declaim (optimize (speed 3))) 25 ;; The following macro may look a bit overcomplicated to the casual 26 ;; reader. The main culprit is the fact that NaN and infinity can be 27 ;; optionally included, which adds a bunch of conditional parts. 29 ;; Assuming you already know more or less how floating point numbers 30 ;; are typically represented, I'll try to elaborate a bit on the more 31 ;; confusing parts, as marked by letters: 33 ;; (A) Exponents in IEEE floats are offset by half their range, for 34 ;; example with 8 exponent bits a number with exponent 2 has 129 35 ;; stored in its exponent field. 37 ;; (B) The maximum possible exponent is reserved for special cases 40 ;; (C) If the exponent fits in the exponent-bits, we have to adjust 41 ;; the significand for the hidden bit. Because decode-float will 42 ;; return a significand between 0 and 1, and we want one between 1 43 ;; and 2 to be able to hide the hidden bit, we double it and then 44 ;; subtract one (the hidden bit) before converting it to integer 45 ;; representation (to adjust for this, 1 is subtracted from the 46 ;; exponent earlier). When the exponent is too small, we set it to 47 ;; zero (meaning no hidden bit, exponent of 1), and adjust the 48 ;; significand downward to compensate for this. 50 ;; (D) Here the hidden bit is added. When the exponent is 0, there is 51 ;; no hidden bit, and the exponent is interpreted as 1. 53 ;; (E) Here the exponent offset is subtracted, but also an extra 54 ;; factor to account for the fact that the bits stored in the 55 ;; significand are supposed to come after the 'decimal dot'. 57 (defmacro make-float-converters (encoder-name 61 support-nan-and-infinity-p) 62 "Writes an encoder and decoder function for floating point 63 numbers with the given amount of exponent and significand 64 bits (plus an extra sign bit). If support-nan-and-infinity-p is 65 true, the decoders will also understand these special cases. NaN 66 is represented as :not-a-number, and the infinities as 67 :positive-infinity and :negative-infinity. Note that this means 68 that the in- or output of these functions is not just floating 69 point numbers anymore, but also keywords." 70 (declare (boolean support-nan-and-infinity-p) 71 (fixnum exponent-bits significand-bits)) 72 (let* ((total-bits (+ 1 exponent-bits significand-bits)) 73 (exponent-offset (1- (expt 2 (1- exponent-bits)))) ; (A) 74 (sign-part `(ldb (byte 1 ,(1- total-bits)) bits)) 75 (exponent-part `(ldb (byte ,exponent-bits ,significand-bits) bits)) 76 (significand-part `(ldb (byte ,significand-bits 0) bits)) 77 (nan support-nan-and-infinity-p) 78 (max-exponent (1- (expt 2 exponent-bits)))) ; (B) 80 (defun ,encoder-name (float) 81 ,@(unless nan `((declare (type float float)))) 82 (multiple-value-bind (sign significand exponent) 83 (cond ,@(when nan `(((eq float :not-a-number) 84 (values 0 1 ,max-exponent)) 85 ((eq float :positive-infinity) 86 (values 0 0 ,max-exponent)) 87 ((eq float :negative-infinity) 88 (values 1 0 ,max-exponent)))) 90 (multiple-value-bind (significand exponent sign) (decode-float float) 91 (let ((exponent (if (= 0 significand) 93 (+ (1- exponent) ,exponent-offset))) 94 (sign (if (= sign 1.0) 0 1))) 95 (unless (< exponent ,(expt 2 exponent-bits)) 96 (error "Floating point overflow when encoding ~A." float)) 97 (if (<= exponent 0) ; (C) 98 (values sign (ash (round (* ,(expt 2 significand-bits) significand)) exponent) 0) 99 (values sign (round (* ,(expt 2 significand-bits) (1- (* significand 2)))) exponent)))))) 101 (declare (type (unsigned-byte ,total-bits) bits)) 102 (setf ,sign-part sign 103 ,exponent-part exponent 104 ,significand-part significand) 107 (defun ,decoder-name (bits) 108 (declare (type (unsigned-byte ,total-bits) bits)) 109 (let* ((sign ,sign-part) 110 (exponent ,exponent-part) 111 (significand ,significand-part)) 112 ,@(when nan `((when (= exponent ,max-exponent) 113 (return-from ,decoder-name 114 (cond ((not (zerop significand)) :not-a-number) 115 ((zerop sign) :positive-infinity) 116 (t :negative-infinity)))))) 117 (if (zerop exponent) ; (D) 119 (setf (ldb (byte 1 ,significand-bits) significand) 1)) 120 (let ((float-significand (float significand ,(if (> total-bits 32) 1.0d0 1.0f0)))) 121 (scale-float (if (zerop sign) float-significand (- float-significand)) 122 (- exponent ,(+ exponent-offset significand-bits))))))))) ; (E) 124 ;; And instances of the above for the common forms of floats. 125 (declaim (inline encode-float32 decode-float32 encode-float64 decode-float64)) 126 (make-float-converters encode-float32 decode-float32 8 23 nil) 127 (make-float-converters encode-float64 decode-float64 11 52 nil) 129 ;;; Copyright (c) 2006 Marijn Haverbeke 131 ;;; This software is provided 'as-is', without any express or implied 132 ;;; warranty. In no event will the authors be held liable for any 133 ;;; damages arising from the use of this software. 135 ;;; Permission is granted to anyone to use this software for any 136 ;;; purpose, including commercial applications, and to alter it and 137 ;;; redistribute it freely, subject to the following restrictions: 139 ;;; 1. The origin of this software must not be misrepresented; you must 140 ;;; not claim that you wrote the original software. If you use this 141 ;;; software in a product, an acknowledgment in the product 142 ;;; documentation would be appreciated but is not required. 144 ;;; 2. Altered source versions must be plainly marked as such, and must 145 ;;; not be misrepresented as being the original software. 147 ;;; 3. This notice may not be removed or altered from any source