├── .gitignore ├── .gitattributes ├── float-features-tests.asd ├── README.md ├── float-features.asd ├── package.lisp ├── LICENSE ├── nan.lisp ├── .github └── workflows │ └── ci.yml ├── infinity.lisp ├── test-float-features.lisp ├── documentation.lisp ├── float-features.lisp └── docs └── index.html /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | #* 3 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | doc/ linguist-vendored -------------------------------------------------------------------------------- /float-features-tests.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem float-features-tests 2 | :version "1.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "Tests for Float Features" 7 | :perform (asdf:test-op (op c) (uiop:symbol-call :parachute :test :float-features-tests)) 8 | :homepage "https://shinmera.com/project/float-features" 9 | :serial T 10 | :components ((:file "test-float-features")) 11 | :depends-on (:float-features :parachute)) 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # This repository has [moved](https://shinmera.com/projects/float-features)! 2 | Due to Microsoft's continued enshittification of the platform this repository has been moved to [Codeberg](https://shinmera.com/projects/float-features) in August of 2025. It will not receive further updates or patches. **Issues and pull requests will not be looked at here either**, please submit your patches and issue tickets on Codeberg, or send them directly via good old email patches to [shirakumo@tymoon.eu](mailto:shirakumo@tymoon.eu). 3 | 4 | Thanks. -------------------------------------------------------------------------------- /float-features.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem float-features 2 | :version "1.0.0" 3 | :license "zlib" 4 | :author "Yukari Hafner " 5 | :maintainer "Yukari Hafner " 6 | :description "A portability library for IEEE float features not covered by the CL standard." 7 | :homepage "https://shinmera.com/project/float-features" 8 | :serial T 9 | :components ((:file "package") 10 | (:file "infinity") 11 | (:file "float-features") 12 | (:file "nan") 13 | (:file "documentation")) 14 | :in-order-to ((asdf:test-op (asdf:test-op :float-features-tests))) 15 | :depends-on (:trivial-features :documentation-utils)) 16 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:float-features 2 | (:nicknames #:org.shirakumo.float-features) 3 | (:use #:cl) 4 | (:export 5 | #:short-float-positive-infinity 6 | #:short-float-negative-infinity 7 | #:short-float-nan 8 | #:single-float-positive-infinity 9 | #:single-float-negative-infinity 10 | #:single-float-nan 11 | #:double-float-positive-infinity 12 | #:double-float-negative-infinity 13 | #:double-float-nan 14 | #:long-float-positive-infinity 15 | #:long-float-negative-infinity 16 | #:long-float-nan 17 | #:float-infinity-p 18 | #:float-nan-p 19 | #:with-float-traps-masked 20 | #:with-rounding-mode 21 | #:short-float-bits 22 | #:single-float-bits 23 | #:double-float-bits 24 | #:long-float-bits 25 | #:bits-short-float 26 | #:bits-single-float 27 | #:bits-double-float 28 | #:bits-long-float)) 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018 Yukari Hafner 2 | 3 | This software is provided 'as-is', without any express or implied 4 | warranty. In no event will the authors be held liable for any damages 5 | arising from the use of this software. 6 | 7 | Permission is granted to anyone to use this software for any purpose, 8 | including commercial applications, and to alter it and redistribute it 9 | freely, subject to the following restrictions: 10 | 11 | 1. The origin of this software must not be misrepresented; you must not 12 | claim that you wrote the original software. If you use this software 13 | in a product, an acknowledgment in the product documentation would be 14 | appreciated but is not required. 15 | 2. Altered source versions must be plainly marked as such, and must not be 16 | misrepresented as being the original software. 17 | 3. This notice may not be removed or altered from any source distribution. 18 | -------------------------------------------------------------------------------- /nan.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.float-features) 2 | 3 | (handler-case 4 | (progn 5 | (bits-short-float 0) 6 | (defconstant SHORT-FLOAT-NAN 7 | (bits-short-float #b0111111000000000))) 8 | (error () 9 | (define-symbol-macro SHORT-FLOAT-NAN 10 | (bits-short-float #b0111111000000000)))) 11 | 12 | (handler-case 13 | (progn 14 | (bits-single-float 0) 15 | (defconstant SINGLE-FLOAT-NAN 16 | (bits-single-float #b01111111110000000000000000000000))) 17 | (error () 18 | (define-symbol-macro SINGLE-FLOAT-NAN 19 | (bits-single-float #b01111111110000000000000000000000)))) 20 | 21 | (handler-case 22 | (progn 23 | (bits-double-float 0) 24 | (defconstant DOUBLE-FLOAT-NAN 25 | (bits-double-float #b0111111111111000000000000000000000000000000000000000000000000000))) 26 | (error () 27 | (define-symbol-macro DOUBLE-FLOAT-NAN 28 | (bits-double-float #b0111111111111000000000000000000000000000000000000000000000000000)))) 29 | 30 | (handler-case 31 | (progn 32 | (bits-long-float 0) 33 | (defconstant LONG-FLOAT-NAN 34 | (bits-long-float #b01111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))) 35 | (error () 36 | (define-symbol-macro LONG-FLOAT-NAN 37 | (bits-long-float #b01111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)))) 38 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | pull_request: 6 | branches: [ master ] 7 | jobs: 8 | test: 9 | name: ${{ matrix.lisp }} on ${{ matrix.os }} 10 | strategy: 11 | matrix: 12 | # clisp doesn't run on ubuntu VMs currently 13 | lisp: [sbcl-bin,sbcl,ccl,ccl32,ecl,allegro,cmucl,abcl] 14 | os: [ubuntu-latest] 15 | fail-fast: false 16 | 17 | # run the job on every combination of "lisp" and "os" above 18 | runs-on: ${{ matrix.os }} 19 | 20 | steps: 21 | - uses: actions/checkout@v2 22 | 23 | - name: cache .roswell 24 | id: cache-dot-roswell 25 | uses: actions/cache@v1 26 | with: 27 | path: ~/.roswell 28 | key: ${{ runner.os }}-dot-roswell-${{ matrix.lisp }}-${{ hashFiles('**/*.asd') }} 29 | restore-keys: | 30 | ${{ runner.os }}-dot-roswell-${{ matrix.lisp }}- 31 | ${{ runner.os }}-dot-roswell- 32 | 33 | - name: install roswell 34 | # always run install, since it does some global installs and setup that isn't cached 35 | env: 36 | LISP: ${{ matrix.lisp }} 37 | run: curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh -x 38 | 39 | - name: install parachute 40 | run: | 41 | ros install parachute 42 | echo "$HOME/.roswell/bin" >> $GITHUB_PATH 43 | 44 | - name: run lisp 45 | continue-on-error: true 46 | shell: bash 47 | run: | 48 | ros -e '(format t "~a:~a on ~a~%...~%~%" (lisp-implementation-type) (lisp-implementation-version) (machine-type))' 49 | ros -e '(format t " fixnum bits:~a~%" (integer-length most-positive-fixnum))' 50 | ros -e "(ql:quickload 'trivial-features)" -e '(format t "features = ~s~%" *features*)' 51 | 52 | - name: update ql dist if we have one cached 53 | shell: bash 54 | run: ros -e "(ql:update-all-dists :prompt nil)" 55 | 56 | - name: load code and run tests 57 | shell: bash 58 | run: | 59 | run-parachute -l "float-features-tests" "float-features-tests" -------------------------------------------------------------------------------- /infinity.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.float-features) 2 | 3 | (defconstant SHORT-FLOAT-POSITIVE-INFINITY 4 | #+ccl 1S++0 5 | #+clasp EXT:SHORT-FLOAT-POSITIVE-INFINITY 6 | #+cmucl EXTENSIONS:SHORT-FLOAT-POSITIVE-INFINITY 7 | #+ecl EXT:SHORT-FLOAT-POSITIVE-INFINITY 8 | #+mezzano MEZZANO.EXTENSIONS:SHORT-FLOAT-POSITIVE-INFINITY 9 | #+mkcl EXT:SHORT-FLOAT-POSITIVE-INFINITY 10 | #+sbcl SB-EXT:SHORT-FLOAT-POSITIVE-INFINITY 11 | #+lispworks 1S++0 12 | #+allegro (coerce excl:*infinity-single* 'short-float) 13 | #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks allegro) 14 | MOST-POSITIVE-SHORT-FLOAT) 15 | 16 | (defconstant SHORT-FLOAT-NEGATIVE-INFINITY 17 | #+ccl -1S++0 18 | #+clasp EXT:SHORT-FLOAT-NEGATIVE-INFINITY 19 | #+cmucl EXTENSIONS:SHORT-FLOAT-NEGATIVE-INFINITY 20 | #+ecl EXT:SHORT-FLOAT-NEGATIVE-INFINITY 21 | #+mezzano MEZZANO.EXTENSIONS:SHORT-FLOAT-NEGATIVE-INFINITY 22 | #+mkcl EXT:SHORT-FLOAT-NEGATIVE-INFINITY 23 | #+sbcl SB-EXT:SHORT-FLOAT-NEGATIVE-INFINITY 24 | #+lispworks -1S++0 25 | #+allegro (coerce excl:*negative-infinity-single* 'short-float) 26 | #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks allegro) 27 | MOST-NEGATIVE-SHORT-FLOAT) 28 | 29 | (defconstant SINGLE-FLOAT-POSITIVE-INFINITY 30 | #+abcl EXTENSIONS:SINGLE-FLOAT-POSITIVE-INFINITY 31 | #+allegro excl:*infinity-single* 32 | #+ccl 1F++0 33 | #+clasp EXT:SINGLE-FLOAT-POSITIVE-INFINITY 34 | #+cmucl EXTENSIONS:SINGLE-FLOAT-POSITIVE-INFINITY 35 | #+ecl EXT:SINGLE-FLOAT-POSITIVE-INFINITY 36 | #+mezzano MEZZANO.EXTENSIONS:SINGLE-FLOAT-POSITIVE-INFINITY 37 | #+mkcl MKCL:SINGLE-FLOAT-POSITIVE-INFINITY 38 | #+sbcl SB-EXT:SINGLE-FLOAT-POSITIVE-INFINITY 39 | #+lispworks 1F++0 40 | #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks) 41 | MOST-POSITIVE-SINGLE-FLOAT) 42 | 43 | (defconstant SINGLE-FLOAT-NEGATIVE-INFINITY 44 | #+abcl EXTENSIONS:SINGLE-FLOAT-NEGATIVE-INFINITY 45 | #+allegro excl:*negative-infinity-single* 46 | #+ccl -1F++0 47 | #+clasp EXT:SINGLE-FLOAT-NEGATIVE-INFINITY 48 | #+cmucl EXTENSIONS:SINGLE-FLOAT-NEGATIVE-INFINITY 49 | #+ecl EXT:SINGLE-FLOAT-NEGATIVE-INFINITY 50 | #+mezzano MEZZANO.EXTENSIONS:SINGLE-FLOAT-NEGATIVE-INFINITY 51 | #+mkcl MKCL:SINGLE-FLOAT-NEGATIVE-INFINITY 52 | #+sbcl SB-EXT:SINGLE-FLOAT-NEGATIVE-INFINITY 53 | #+lispworks -1F++0 54 | #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks) 55 | MOST-NEGATIVE-SINGLE-FLOAT) 56 | 57 | (defconstant DOUBLE-FLOAT-POSITIVE-INFINITY 58 | #+abcl EXTENSIONS:DOUBLE-FLOAT-POSITIVE-INFINITY 59 | #+allegro excl:*infinity-double* 60 | #+ccl 1D++0 61 | #+clasp EXT:DOUBLE-FLOAT-POSITIVE-INFINITY 62 | #+cmucl EXTENSIONS:DOUBLE-FLOAT-POSITIVE-INFINITY 63 | #+ecl EXT:DOUBLE-FLOAT-POSITIVE-INFINITY 64 | #+mezzano MEZZANO.EXTENSIONS:DOUBLE-FLOAT-POSITIVE-INFINITY 65 | #+mkcl MKCL:DOUBLE-FLOAT-POSITIVE-INFINITY 66 | #+sbcl SB-EXT:DOUBLE-FLOAT-POSITIVE-INFINITY 67 | #+lispworks 1D++0 68 | #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks) 69 | MOST-POSITIVE-DOUBLE-FLOAT) 70 | 71 | (defconstant DOUBLE-FLOAT-NEGATIVE-INFINITY 72 | #+abcl EXTENSIONS:DOUBLE-FLOAT-NEGATIVE-INFINITY 73 | #+allegro excl:*negative-infinity-double* 74 | #+ccl -1D++0 75 | #+clasp EXT:DOUBLE-FLOAT-NEGATIVE-INFINITY 76 | #+cmucl EXTENSIONS:DOUBLE-FLOAT-NEGATIVE-INFINITY 77 | #+ecl EXT:DOUBLE-FLOAT-NEGATIVE-INFINITY 78 | #+mezzano MEZZANO.EXTENSIONS:DOUBLE-FLOAT-NEGATIVE-INFINITY 79 | #+mkcl MKCL:DOUBLE-FLOAT-NEGATIVE-INFINITY 80 | #+sbcl SB-EXT:DOUBLE-FLOAT-NEGATIVE-INFINITY 81 | #+lispworks -1D++0 82 | #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks) 83 | MOST-NEGATIVE-DOUBLE-FLOAT) 84 | 85 | (defconstant LONG-FLOAT-POSITIVE-INFINITY 86 | #+ccl 1L++0 87 | #+clasp EXT:LONG-FLOAT-POSITIVE-INFINITY 88 | #+cmucl EXTENSIONS:LONG-FLOAT-POSITIVE-INFINITY 89 | #+ecl EXT:LONG-FLOAT-POSITIVE-INFINITY 90 | #+mezzano MEZZANO.EXTENSIONS:LONG-FLOAT-POSITIVE-INFINITY 91 | #+mkcl EXT:LONG-FLOAT-POSITIVE-INFINITY 92 | #+sbcl SB-EXT:LONG-FLOAT-POSITIVE-INFINITY 93 | #+lispworks 1L++0 94 | #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks) 95 | MOST-POSITIVE-LONG-FLOAT) 96 | 97 | (defconstant LONG-FLOAT-NEGATIVE-INFINITY 98 | #+ccl -1L++0 99 | #+clasp EXT:LONG-FLOAT-NEGATIVE-INFINITY 100 | #+cmucl EXTENSIONS:LONG-FLOAT-NEGATIVE-INFINITY 101 | #+ecl EXT:LONG-FLOAT-NEGATIVE-INFINITY 102 | #+mezzano MEZZANO.EXTENSIONS:LONG-FLOAT-NEGATIVE-INFINITY 103 | #+mkcl EXT:LONG-FLOAT-NEGATIVE-INFINITY 104 | #+sbcl SB-EXT:LONG-FLOAT-NEGATIVE-INFINITY 105 | #+lispworks -1L++0 106 | #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks) 107 | MOST-NEGATIVE-LONG-FLOAT) 108 | -------------------------------------------------------------------------------- /test-float-features.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-user) 2 | 3 | (defpackage #:float-features-tests 4 | (:nicknames #:org.shirakumo.float-features-tests) 5 | (:use #:cl)) 6 | 7 | ;;; to run (parachute:test :float-features-tests) 8 | (in-package #:float-features-tests) 9 | 10 | (parachute:define-test float-features-divide-by-fp-zero-trapped 11 | :compile-at :compile-time 12 | (parachute:true 13 | (float-features:float-infinity-p 14 | (float-features:with-float-traps-masked (:divide-by-zero) 15 | (/ (read-from-string "23") (read-from-string "0.0")))))) 16 | 17 | (parachute:define-test float-features-divide-by-fp-zero-non-trapped 18 | :compile-at :compile-time 19 | (parachute:true 20 | (handler-case 21 | (float-features:with-float-traps-masked () 22 | (/ (read-from-string "23") (read-from-string "0.0"))) 23 | (division-by-zero (error) 24 | (values t error))))) 25 | 26 | (parachute:define-test float-features-overflow-trapped 27 | :compile-at :compile-time 28 | (parachute:true 29 | (float-features:float-infinity-p 30 | (float-features:with-float-traps-masked (:overflow :inexact) 31 | (+ (symbol-value 'most-positive-long-float) 32 | (symbol-value 'most-positive-long-float)))))) 33 | 34 | (parachute:define-test float-features-overflow-non-trapped 35 | :compile-at :compile-time 36 | (parachute:true 37 | (handler-case 38 | (float-features:with-float-traps-masked () 39 | (+ (symbol-value 'most-positive-long-float) 40 | (symbol-value 'most-positive-long-float))) 41 | (floating-point-overflow (error) 42 | (values t error))))) 43 | 44 | (parachute:define-test float-features-overflow-or-inexact-trapped 45 | :compile-at :compile-time 46 | (parachute:true 47 | (float-features:float-infinity-p 48 | (float-features:with-float-traps-masked (:overflow :inexact) 49 | (+ (- (symbol-value 'most-positive-long-float) (read-from-string "3")) 50 | (- (symbol-value 'most-positive-long-float) (read-from-string "3"))))))) 51 | 52 | (parachute:define-test float-features-overflow-or-inexact-non-trapped 53 | :compile-at :compile-time 54 | (parachute:true 55 | (handler-case 56 | (float-features:with-float-traps-masked () 57 | (+ (- (symbol-value 'most-positive-long-float) (read-from-string "3")) 58 | (- (symbol-value 'most-positive-long-float) (read-from-string "3")))) 59 | (floating-point-inexact (error) 60 | (values t error)) 61 | (floating-point-overflow (error) 62 | (values t error))))) 63 | 64 | (parachute:define-test float-features-invalid-trapped 65 | :compile-at :compile-time 66 | (parachute:true 67 | (float-features:float-nan-p 68 | (float-features:with-float-traps-masked (:invalid) 69 | (/ (read-from-string "0.0") (read-from-string "0.0")))))) 70 | 71 | (parachute:define-test float-features-invalid-non-trapped 72 | :compile-at :compile-time 73 | (parachute:true 74 | (handler-case 75 | (float-features:with-float-traps-masked () 76 | (/ (read-from-string "0.0") (read-from-string "0.0"))) 77 | (floating-point-inexact (error) 78 | (values t error)) 79 | (division-by-zero (error) 80 | (values t error)) 81 | (floating-point-invalid-operation (error) 82 | (values t error))))) 83 | 84 | (parachute:define-test negative-bits-to-float 85 | :compile-at :compile-time 86 | (parachute:skip-on (ecl abcl) "not implemented" 87 | (parachute:is = -1f0 (float-features:bits-single-float #xBF800000)) 88 | (parachute:is = -1d0 (float-features:bits-double-float #xBFF0000000000000)) 89 | (parachute:is = #xBF800000 (float-features:single-float-bits -1f0)) 90 | (parachute:is = #xBFF0000000000000 (float-features:double-float-bits -1d0)))) 91 | 92 | 93 | ;; ecl is missingl bits-single-float/single-float-bits used by short versions 94 | (parachute:define-test short-float-round-trip 95 | :compile-at :compile-time 96 | (parachute:skip-on (ecl abcl) "not implemented" 97 | (parachute:skip-on (allegro) "no idea, probably NaN stuff?" 98 | (parachute:true 99 | (float-features:with-float-traps-masked t 100 | (loop for i from 0 below 65536 101 | always (= i (float-features:short-float-bits 102 | (float-features:bits-short-float i))))))))) 103 | 104 | (defun short-bits-double (i) 105 | (cond 106 | ((zerop (ldb (byte 15 0) i)) 107 | 0d0) 108 | ((zerop (ldb (byte 5 10) i)) 109 | (* (if (logbitp 15 i) -1 1) 110 | (expt 2 -14) 111 | (+ 0d0 (/ (ldb (byte 10 0) i) 1024)))) 112 | (t (* (if (logbitp 15 i) -1 1) 113 | (expt 2 (- (ldb (byte 5 10) i) 15)) 114 | (+ 1d0 (/ (ldb (byte 10 0) i) 1024)))))) 115 | 116 | (parachute:define-test short-float 117 | :compile-at :compile-time 118 | (parachute:skip-on (ecl abcl) "not implemented" 119 | ;; examples from wikipedia 120 | (parachute:is = 0.000000059604645s0 (float-features:bits-short-float 1)) 121 | (parachute:is = 0.000060975552s0 (float-features:bits-short-float #x03ff)) 122 | (parachute:is = 0.000061035156s0 (float-features:bits-short-float #x0400)) 123 | (parachute:is = 65504s0 (float-features:bits-short-float #x7bff)) 124 | (parachute:is = 0.99951172s0 (float-features:bits-short-float #x3bff)) 125 | (parachute:is = 1s0 (float-features:bits-short-float #x3c00)) 126 | (parachute:is = 1.00097656s0 (float-features:bits-short-float #x3c01)) 127 | (parachute:is = 0.33325195s0 (float-features:bits-short-float #x3555)) 128 | (parachute:is = -2s0 (float-features:bits-short-float #xc000)) 129 | (parachute:is = 0s0 (float-features:bits-short-float #x0000)) 130 | (parachute:is = -0s0 (float-features:bits-short-float #x8000)) 131 | (parachute:is = float-features:short-float-positive-infinity 132 | (float-features:bits-short-float #x7c00)) 133 | (parachute:is = float-features:short-float-negative-infinity 134 | (float-features:bits-short-float #xfc00)) 135 | (parachute:true (float-features:float-nan-p 136 | (float-features:bits-short-float #xffff))) 137 | (parachute:true (float-features:float-nan-p 138 | (float-features:with-float-traps-masked t 139 | (float-features:bits-short-float #xfd00)))) 140 | ;; make sure all values are approximately right 141 | (parachute:true 142 | (loop for i below 65536 143 | for s = (float-features:with-float-traps-masked t 144 | (float-features:bits-short-float i)) 145 | for f = (short-bits-double i) 146 | always (or (float-features:float-nan-p s) 147 | (float-features:float-infinity-p s) 148 | (<= (abs (- f s)) 149 | (abs (* f single-float-epsilon)))))))) 150 | 151 | ;; These are necessary to avoid the constant folding 152 | (defun add (x y) (+ x y)) 153 | 154 | (parachute:define-test rounding-modes 155 | :compile-at :compile-time 156 | (parachute:skip-on (ecl abcl allegro clasp lispworks) "not implemented" 157 | (parachute:is = 4.500000000000001d0 (float-features:with-rounding-mode :positive (add 3.2D0 1.3D0))) 158 | (parachute:is = 4.5d0 (float-features:with-rounding-mode :negative (add 3.2D0 1.3D0))) 159 | (parachute:is = 4.5d0 (float-features:with-rounding-mode :nearest (add 3.2D0 1.3D0))) 160 | (parachute:is = 4.5d0 (float-features:with-rounding-mode :zero (add 3.2D0 1.3D0))))) 161 | -------------------------------------------------------------------------------- /documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.float-features) 2 | 3 | (docs:define-docs 4 | (variable short-float-positive-infinity 5 | "The positive infinity for short-floats. 6 | 7 | Supported on: 8 | * ALLEGRO 9 | * CCL 10 | * CMUCL 11 | * ECL 12 | * LISPWORKS 13 | * MEZZANO 14 | * MKCL 15 | * SBCL 16 | 17 | Defaults to MOST-POSITIVE-SHORT-FLOAT on unsupported implementations.") 18 | 19 | (variable short-float-negative-infinity 20 | "The negative infinity for short-floats. 21 | 22 | Supported on: 23 | * ALLEGRO 24 | * CCL 25 | * CMUCL 26 | * ECL 27 | * LISPWORKS 28 | * MEZZANO 29 | * MKCL 30 | * SBCL 31 | 32 | Defaults to MOST-NEGATIVE-SHORT-FLOAT on unsupported implementations.") 33 | 34 | (variable short-float-nan 35 | "A positive quiet NaN value with zero-cleared payload for short-floats. 36 | This value should NOT be used for comparison with a float value for the pupose of testing NaN 37 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information. 38 | Comparing this value with other NaN representations via = will fail. 39 | To test if a number is a NaN, use FLOAT-NAN-P. 40 | 41 | It is supported on implementations which support BITS-SHORT-FLOAT. 42 | 43 | Defaults to MOST-POSITIVE-SHORT-FLOAT on unsupported implementations.") 44 | 45 | (variable single-float-positive-infinity 46 | "The positive infinity for single-floats. 47 | 48 | Supported on: 49 | * ABCL 50 | * ALLEGRO 51 | * CCL 52 | * CMUCL 53 | * ECL 54 | * LISPWORKS 55 | * MEZZANO 56 | * MKCL 57 | * SBCL 58 | 59 | Defaults to MOST-POSITIVE-SINGLE-FLOAT on unsupported implementations.") 60 | 61 | (variable single-float-negative-infinity 62 | "The negative infinity for single-floats. 63 | 64 | Supported on: 65 | * ABCL 66 | * ALLEGRO 67 | * CCL 68 | * CMUCL 69 | * ECL 70 | * LISPWORKS 71 | * MEZZANO 72 | * MKCL 73 | * SBCL 74 | 75 | Defaults to MOST-NEGATIVE-SINGLE-FLOAT on unsupported implementations.") 76 | 77 | (variable single-float-nan 78 | "A positive quiet NaN value with zero-cleared payload for single-floats. 79 | This value should NOT be used for comparison with a float value for the pupose of testing NaN 80 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information. 81 | Comparing this value with other NaN representations via = will fail. 82 | To test if a number is a NaN, use FLOAT-NAN-P. 83 | 84 | It is supported on implementations which support BITS-SINGLE-FLOAT. 85 | 86 | Defaults to MOST-POSITIVE-SINGLE-FLOAT on unsupported implementations.") 87 | 88 | (variable double-float-positive-infinity 89 | "The positive infinity for double-floats. 90 | 91 | Supported on: 92 | * ABCL 93 | * ALLEGRO 94 | * CCL 95 | * CMUCL 96 | * ECL 97 | * LISPWORKS 98 | * MEZZANO 99 | * MKCL 100 | * SBCL 101 | 102 | Defaults to MOST-POSITIVE-DOUBLE-FLOAT on unsupported implementations.") 103 | 104 | (variable double-float-negative-infinity 105 | "The negative infinity for double-floats. 106 | 107 | Supported on: 108 | * ABCL 109 | * ALLEGRO 110 | * CCL 111 | * CMUCL 112 | * ECL 113 | * LISPWORKS 114 | * MEZZANO 115 | * MKCL 116 | * SBCL 117 | 118 | Defaults to MOST-NEGATIVE-DOUBLE-FLOAT on unsupported implementations.") 119 | 120 | (variable double-float-nan 121 | "A positive quiet NaN value with zero-cleared payload for double-floats. 122 | This value should NOT be used for comparison with a float value for the pupose of testing NaN 123 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information. 124 | Comparing this value with other NaN representations via = will fail. 125 | To test if a number is a NaN, use FLOAT-NAN-P. 126 | 127 | It is supported on implementations which support BITS-DOUBLE-FLOAT. 128 | 129 | Defaults to MOST-POSITIVE-DOUBLE-FLOAT on unsupported implementations.") 130 | 131 | (variable long-float-positive-infinity 132 | "The positive infinity for long-floats. 133 | 134 | Supported on: 135 | * CCL 136 | * CMUCL 137 | * ECL 138 | * LISPWORKS 139 | * MEZZANO 140 | * MKCL 141 | * SBCL 142 | 143 | Defaults to MOST-POSITIVE-LONG-FLOAT on unsupported implementations.") 144 | 145 | (variable long-float-negative-infinity 146 | "The negative infinity for long-floats. 147 | 148 | Supported on: 149 | * CCL 150 | * CMUCL 151 | * ECL 152 | * LISPWORKS 153 | * MEZZANO 154 | * MKCL 155 | * SBCL 156 | 157 | Defaults to MOST-NEGATIVE-LONG-FLOAT on unsupported implementations.") 158 | 159 | (variable long-float-nan 160 | "A positive quiet NaN value with zero-cleared payload for long-floats. 161 | This value should NOT be used for comparison with a float value for the pupose of testing NaN 162 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information. 163 | Comparing this value with other NaN representations via = will fail. 164 | To test if a number is a NaN, use FLOAT-NAN-P. 165 | 166 | It is supported on implementations which support BITS-LONG-FLOAT. 167 | 168 | Defaults to MOST-POSITIVE-LONG-FLOAT on unsupported implementations.") 169 | 170 | (function float-infinity-p 171 | "Returns T if the given float is an infinity, NIL otherwise. 172 | 173 | Supported on: 174 | * ABCL 175 | * ALLEGRO 176 | * CCL 177 | * CMUCL 178 | * ECL 179 | * LISPWORKS 180 | * MEZZANO 181 | * SBCL 182 | 183 | Defaults to comparing against the individual constants on unsupported 184 | implementations.") 185 | 186 | (function float-nan-p 187 | "Returns T if the given float is in not-a-number state, NIL otherwise. 188 | 189 | Supported on: 190 | * ABCL 191 | * ALLEGRO 192 | * CCL 193 | * CMUCL 194 | * ECL 195 | * LISPWORKS 196 | * MEZZANO 197 | * SBCL 198 | 199 | Defaults to returning NIL on unsupported implementations.") 200 | 201 | (function with-float-traps-masked 202 | "Attempts to mask the given floating point traps. 203 | 204 | Masking a floating point trap causes the given floating point exception 205 | to not signal a condition in the lisp world, and instead lets the 206 | operation return a float that is either a NaN or an infinity. 207 | 208 | The following traps are recognised: 209 | 210 | :underflow 211 | :overflow 212 | :inexact 213 | :invalid 214 | :divide-by-zero 215 | :denormalized-operand 216 | 217 | The traps argument may be either a list of the above trap identifiers, 218 | or T to signify all maskable traps. 219 | 220 | Note that not all implementations will signal conditions on all of the 221 | above floating point traps anyway, and some implementations may only 222 | support masking some of the above traps. 223 | 224 | Supported on: 225 | * ABCL (:overflow :underflow) 226 | * CCL (:overflow :underflow :inexact :invalid :divide-by-zero) 227 | * CLISP (:underflow) 228 | * CMUCL T 229 | * ECL (:underflow :overflow :inexact :invalid :divide-by-zero) 230 | * MEZZANO T 231 | * SBCL T 232 | 233 | Defaults to a progn on unsupported implementations and ignores 234 | unsupported traps.") 235 | 236 | (function with-rounding-mode 237 | "Temporarily set rounding mode when execute body. 238 | 239 | The following modes are recognised: 240 | 241 | :nearest Round to nearest, ties to even 242 | :positive Round toward positive infinity 243 | :negative Round toward negative infinity 244 | :zero Round toward zero 245 | 246 | Note that many compilers would by default try to fold floating point 247 | expressions into constants before the rounding mode can take effect. 248 | It is advisory to check disassembled functions to see if that is the 249 | case when the result is not expected. 250 | 251 | Supported on: 252 | * CCL 253 | * CMUCL 254 | * MEZZANO 255 | * SBCL 256 | 257 | Signals an error on unsupported implementations.") 258 | 259 | (function short-float-bits 260 | "Returns the bit representation of the short-float as an (unsigned-byte 16). 261 | 262 | Supported on: 263 | * MEZZANO 264 | 265 | Supported (with 32bit short-float = single-float) on: 266 | * ALLEGRO 267 | * CCL 268 | * CMUCL 269 | * ECL 270 | * LISPWORKS (64-bit only. on 32-bit lw, short-float is not 16 or 32 bits) 271 | * SBCL 272 | 273 | On platforms with 32-bit short-float, low bits of significand are 274 | dropped without rounding, and out of range exponents are converted to 275 | infinities. All values returned by bits-short-float should convert 276 | back to the same bits. 277 | 278 | Defaults to signalling an error on unsupported implementations.") 279 | 280 | (function single-float-bits 281 | "Returns the bit representation of the single-float as an (unsigned-byte 32). 282 | 283 | Supported on: 284 | * ABCL 285 | * ALLEGRO 286 | * CCL 287 | * CLASP 288 | * CMUCL 289 | * LISPWORKS 290 | * MEZZANO 291 | * SBCL 292 | 293 | Defaults to signalling an error on unsupported implementations.") 294 | 295 | (function double-float-bits 296 | "Returns the bit representation of the double-float as an (unsigned-byte 64). 297 | 298 | Supported on: 299 | * ABCL 300 | * ALLEGRO 301 | * CCL 302 | * CLASP 303 | * CMUCL 304 | * LISPWORKS 305 | * MEZZANO 306 | * SBCL 307 | 308 | Defaults to signalling an error on unsupported implementations.") 309 | 310 | (function long-float-bits 311 | "Returns the bit representation of the long-float as an (unsigned-byte 128). 312 | 313 | Supported on: 314 | 315 | Defaults to signalling an error on unsupported implementations.") 316 | 317 | (function bits-short-float 318 | "Encodes the (unsigned-byte 16) bit representation into a native short-float. 319 | 320 | Supported on: 321 | * MEZZANO 322 | 323 | Supported (with 32bit short-float = single-float) on: 324 | * ALLEGRO 325 | * CCL 326 | * CMUCL 327 | * ECL 328 | * LISPWORKS (64-bit only. on 32-bit lw, short-float is not 16 or 32 bits) 329 | * SBCL 330 | 331 | Defaults to signalling an error on unsupported implementations.") 332 | 333 | (function bits-single-float 334 | "Encodes the (unsigned-byte 32) bit representation into a native single-float. 335 | 336 | Supported on: 337 | * ABCL 338 | * ALLEGRO 339 | * CCL 340 | * CLASP 341 | * CMUCL 342 | * LISPWORKS 343 | * MEZZANO 344 | * SBCL 345 | 346 | Defaults to signalling an error on unsupported implementations.") 347 | 348 | (function bits-double-float 349 | "Encodes the (unsigned-byte 64) bit representation into a native double-float. 350 | 351 | Supported on: 352 | * ABCL 353 | * ALLEGRO 354 | * CCL 355 | * CLASP 356 | * CMUCL 357 | * LISPWORKS 358 | * MEZZANO 359 | * SBCL 360 | 361 | Defaults to signalling an error on unsupported implementations.") 362 | 363 | (function bits-long-float 364 | "Encodes the (unsigned-byte 128) bit representation into a native long-float. 365 | 366 | Supported on: 367 | 368 | Defaults to signalling an error on unsupported implementations.")) 369 | -------------------------------------------------------------------------------- /float-features.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.float-features) 2 | 3 | (eval-when (:compile-toplevel :load-toplevel) 4 | #+ecl 5 | (when (find-symbol "BITS-SINGLE-FLOAT" "SYSTEM") (pushnew :ecl-float-bit-translations *features*))) 6 | 7 | (declaim (inline float-infinity-p 8 | float-nan-p)) 9 | 10 | (defun float-infinity-p (float) 11 | #+abcl (system:float-infinity-p float) 12 | #+allegro (excl:infinityp float) 13 | #+ccl (ccl::infinity-p float) 14 | #+clasp (ext:float-infinity-p float) 15 | #+cmucl (extensions:float-infinity-p float) 16 | #+ecl (ext:float-infinity-p float) 17 | #+mezzano (mezzano.extensions:float-infinity-p float) 18 | #+sbcl (sb-ext:float-infinity-p float) 19 | #-(or abcl allegro ccl clasp cmucl ecl mezzano sbcl) 20 | (etypecase float 21 | (short-float (or (= float SHORT-FLOAT-NEGATIVE-INFINITY) 22 | (= float SHORT-FLOAT-POSITIVE-INFINITY))) 23 | (single-float (or (= float SINGLE-FLOAT-NEGATIVE-INFINITY) 24 | (= float SINGLE-FLOAT-POSITIVE-INFINITY))) 25 | (double-float (or (= float DOUBLE-FLOAT-NEGATIVE-INFINITY) 26 | (= float DOUBLE-FLOAT-POSITIVE-INFINITY))) 27 | (long-float (or (= float LONG-FLOAT-NEGATIVE-INFINITY) 28 | (= float LONG-FLOAT-POSITIVE-INFINITY))))) 29 | 30 | (defun float-nan-p (float) 31 | #+abcl (system:float-nan-p float) 32 | #+allegro (and (excl:nanp float) t) 33 | #+ccl (and (ccl::nan-or-infinity-p float) 34 | (not (ccl::infinity-p float))) 35 | #+clasp (ext:float-nan-p float) 36 | #+cmucl (extensions:float-nan-p float) 37 | #+ecl (ext:float-nan-p float) 38 | #+mezzano (mezzano.extensions:float-nan-p float) 39 | #+sbcl (sb-ext:float-nan-p float) 40 | #+lispworks (sys::nan-p float) 41 | #-(or abcl allegro ccl clasp cmucl ecl mezzano sbcl lispworks) 42 | (/= float float)) 43 | 44 | (defmacro with-float-traps-masked (traps &body body) 45 | (let ((traps (etypecase traps 46 | ((eql T) '(:underflow :overflow :inexact :invalid :divide-by-zero :denormalized-operand)) 47 | (list traps)))) 48 | #+abcl 49 | (let ((previous (gensym "PREVIOUS"))) 50 | `(let ((,previous (extensions:get-floating-point-modes))) 51 | (unwind-protect 52 | (progn 53 | (extensions:set-floating-point-modes 54 | :traps ',(intersection traps '(:overflow :underflow))) 55 | NIL ,@body) 56 | (apply #'extensions:set-floating-point-modes ,previous)))) 57 | #+ccl 58 | (let ((previous (gensym "PREVIOUS")) 59 | (traps (loop for thing in traps 60 | for trap = (case thing 61 | (:underflow :underflow) 62 | (:overflow :overflow) 63 | (:divide-by-zero :division-by-zero) 64 | (:invalid :invalid) 65 | (:inexact :inexact)) 66 | when trap collect trap))) 67 | `(let ((,previous (ccl:get-fpu-mode))) 68 | (unwind-protect 69 | (progn 70 | (ccl:set-fpu-mode 71 | ,@(loop for trap in traps 72 | collect trap collect NIL)) 73 | NIL ,@body) 74 | (apply #'ccl:set-fpu-mode ,previous)))) 75 | #+clisp 76 | (if (find :underflow traps) 77 | `(ext:without-floating-point-underflow 78 | ,@body) 79 | `(progn 80 | ,@body)) 81 | #+cmucl 82 | `(extensions:with-float-traps-masked #+x86 ,traps #-x86 ,(remove :denormalized-operand traps) 83 | ,@body) 84 | #+ecl 85 | (let ((previous (gensym "PREVIOUS"))) 86 | `(let ((,previous (ext:trap-fpe 'last NIL))) 87 | (unwind-protect 88 | (progn 89 | ,@(loop for trap in traps 90 | for keyword = (case trap 91 | (:underflow 'floating-point-underflow) 92 | (:overflow 'floating-point-overflow) 93 | (:inexact 'floating-point-inexact) 94 | (:invalid 'floating-point-invalid-operation) 95 | (:divide-by-zero 'division-by-zero)) 96 | when keyword collect `(ext:trap-fpe ',keyword NIL)) 97 | NIL ,@body) 98 | (ext:trap-fpe ,previous T)))) 99 | #+clasp 100 | `(ext:with-float-traps-masked ,traps 101 | ,@body) 102 | #+mezzano 103 | (let ((previous (gensym "PREVIOUS")) 104 | (traps (loop for thing in traps 105 | for trap = (case thing 106 | (:underflow :underflow) 107 | (:overflow :overflow) 108 | (:divide-by-zero :divide-by-zero) 109 | (:invalid :invalid-operation) 110 | (:inexact :precision) 111 | #+x86-64 112 | (:denormalized-operand :denormal-operand)) 113 | when trap collect trap))) 114 | `(let ((,previous (mezzano.runtime::get-fpu-mode))) 115 | (unwind-protect 116 | (progn 117 | (mezzano.runtime::set-fpu-mode 118 | ,@(loop for trap in traps 119 | collect trap collect T)) 120 | NIL ,@body) 121 | (apply #'mezzano.runtime::set-fpu-mode ,previous)))) 122 | #+sbcl 123 | `(sb-int:with-float-traps-masked #+x86 ,traps #-x86 ,(remove :denormalized-operand traps) 124 | ,@body) 125 | #-(or abcl ccl clasp clisp cmucl ecl mezzano sbcl) 126 | (declare (ignore traps)) 127 | #-(or abcl ccl clasp clisp cmucl ecl mezzano sbcl) 128 | `(progn ,@body))) 129 | 130 | (defmacro with-rounding-mode (mode &body body) 131 | #+(or ccl cmucl mezzano sbcl) 132 | (let ((previous (gensym "PREVIOUS")) 133 | (mode #+ccl 134 | (case mode 135 | (:nearest :nearest) 136 | (:positive :positive) 137 | (:negative :negative) 138 | (:zero :zero)) 139 | #+(or cmucl sbcl mezzano) 140 | (case mode 141 | (:nearest :nearest) 142 | (:positive :positive-infinity) 143 | (:negative :negative-infinity) 144 | (:zero :zero)))) 145 | `(let ((,previous #+ccl 146 | (ccl:get-fpu-mode :rounding-mode) 147 | #+cmucl 148 | (getf (extensions:get-floating-point-modes) :rounding-mode) 149 | #+mezzano 150 | (getf (mezzano.runtime::get-fpu-mode) :rounding-mode) 151 | #+sbcl 152 | (getf (sb-int:get-floating-point-modes) :rounding-mode))) 153 | (unwind-protect 154 | (progn 155 | #+ccl 156 | (ccl:set-fpu-mode :rounding-mode ,mode) 157 | #+cmucl 158 | (extensions:set-floating-point-modes :rounding-mode ,mode) 159 | #+mezzano 160 | (mezzano.runtime::set-fpu-mode :rounding-mode ,mode) 161 | #+sbcl 162 | (sb-int:set-floating-point-modes :rounding-mode ,mode) 163 | NIL ,@body) 164 | #+ccl 165 | (ccl:set-fpu-mode :rounding-mode ,previous) 166 | #+cmucl 167 | (extensions:set-floating-point-modes :rounding-mode ,previous) 168 | #+mezzano 169 | (mezzano.runtime::set-fpu-mode :rounding-mode ,previous) 170 | #+sbcl 171 | (sb-int:set-floating-point-modes :rounding-mode ,previous)))) 172 | #-(or ccl cmucl mezzano sbcl) 173 | (declare (ignore traps)) 174 | #-(or ccl cmucl mezzano sbcl) 175 | `(error "Implementation not supported.")) 176 | 177 | (declaim (inline short-float-bits 178 | single-float-bits 179 | double-float-bits 180 | long-float-bits 181 | bits-short-float 182 | bits-single-float 183 | bits-double-float 184 | bits-long-float)) 185 | 186 | (declaim (ftype (function (T) (unsigned-byte 32)) single-float-bits)) 187 | (defun single-float-bits (float) 188 | #+abcl 189 | (ldb (byte 32 0) (system:single-float-bits float)) 190 | #+allegro 191 | (multiple-value-bind (high low) (excl:single-float-to-shorts float) 192 | (logior low (ash high 16))) 193 | #+ccl 194 | (ccl::single-float-bits float) 195 | #+clasp 196 | (ext:single-float-to-bits float) 197 | #+cmucl 198 | (ldb (byte 32 0) (kernel:single-float-bits float)) 199 | #+ecl-float-bit-translations 200 | (si:single-float-bits float) 201 | #+lispworks 202 | (let ((v (sys:make-typed-aref-vector 4))) 203 | (declare (optimize (speed 3) (float 0) (safety 0))) 204 | (declare (dynamic-extent v)) 205 | (setf (sys:typed-aref 'single-float v 0) float) 206 | (sys:typed-aref '(unsigned-byte 32) v 0)) 207 | #+mezzano 208 | (mezzano.extensions:single-float-to-ieee-binary32 float) 209 | #+sbcl 210 | (ldb (byte 32 0) (sb-kernel:single-float-bits float)) 211 | #-(or abcl allegro ccl clasp cmucl ecl-float-bit-translations lispworks mezzano sbcl) 212 | (progn float (error "Implementation not supported."))) 213 | 214 | (declaim (ftype (function (T) (unsigned-byte 16)) short-float-bits)) 215 | (defun short-float-bits (float) 216 | (declare (ignorable float)) 217 | #+mezzano 218 | (mezzano.extensions:short-float-to-ieee-binary16 float) 219 | #+(or ecl sbcl cmucl allegro ccl 220 | (and 64-bit lispworks)) 221 | (let* ((bits (single-float-bits float)) 222 | (sign (ldb (byte 1 31) bits)) 223 | (exp (- (ldb (byte 8 23) bits) 127)) 224 | (sig (ldb (byte 23 0) bits))) 225 | (cond 226 | ((or (eql 0s0 float) 227 | (< exp -24)) 228 | ;;underflow 229 | (ash sign 15)) 230 | ((< exp -14) 231 | ;; encode as denormal if possible 232 | (logior (ash sign 15) 233 | 0 234 | (ash (ldb (byte 11 13) 235 | (logior (ash 1 23) sig)) 236 | (+ exp 14)))) 237 | ((< exp 16) 238 | ;; encode directly 239 | (logior (ash sign 15) 240 | (ash (+ exp 15) 10) 241 | (ash sig -13))) 242 | ((zerop sig) 243 | ;; infinity 244 | (if (zerop sign) 245 | #b0111110000000000 246 | #b1111110000000000)) 247 | (t 248 | ;;NaN 249 | (logior (ash sign 15) 250 | (ash #x1f 10) 251 | (ldb (byte 10 13) sig))))) 252 | ;; clisp short-float is 1+8+16 253 | ;; 32bit lispworks 5+ is 1+8+??, lw4 only has double 254 | ;; not sure about others? 255 | #- (or mezzano ecl sbcl cmucl allegro ccl (and 64-bit lispworks)) 256 | (progn float (error "Implementation not supported."))) 257 | 258 | (declaim (ftype (function (T) (unsigned-byte 64)) double-float-bits)) 259 | (defun double-float-bits (float) 260 | #+abcl 261 | (logior (system::double-float-low-bits float) 262 | (ash (system::double-float-high-bits float) 32)) 263 | #+allegro 264 | (multiple-value-bind (s3 s2 s1 s0) (excl:double-float-to-shorts float) 265 | (logior s0 (ash s1 16) (ash s2 32) (ash s3 48))) 266 | #+ccl 267 | (multiple-value-bind (high low) (ccl::double-float-bits float) 268 | (logior low (ash high 32))) 269 | #+clasp 270 | (ext:double-float-to-bits float) 271 | #+cmucl 272 | (ldb (byte 64 0) 273 | (logior (kernel:double-float-low-bits float) 274 | (ash (kernel:double-float-high-bits float) 32))) 275 | #+ecl-float-bit-translations 276 | (si:double-float-bits float) 277 | #+lispworks 278 | (let ((v (sys:make-typed-aref-vector 8))) 279 | (declare (optimize (speed 3) (float 0) (safety 0))) 280 | (declare (dynamic-extent v)) 281 | (setf (sys:typed-aref 'double-float v 0) float) 282 | #+64-bit (sys:typed-aref '(unsigned-byte 64) v 0) 283 | #+(and 32-bit (not big-endian)) (logior (sys:typed-aref '(unsigned-byte 32) v 0) 284 | (ash (sys:typed-aref '(unsigned-byte 32) v 4) 32)) 285 | #+(and 32-bit big-endian) (logior (sys:typed-aref '(unsigned-byte 32) v 4) 286 | (ash (sys:typed-aref '(unsigned-byte 32) v 0) 32))) 287 | #+mezzano 288 | (mezzano.extensions:double-float-to-ieee-binary64 float) 289 | #+sbcl 290 | (ldb (byte 64 0) 291 | (logior (sb-kernel:double-float-low-bits float) 292 | (ash (sb-kernel:double-float-high-bits float) 32))) 293 | #-(or abcl allegro ccl clasp cmucl ecl-float-bit-translations lispworks mezzano sbcl) 294 | (progn float (error "Implementation not supported."))) 295 | 296 | (declaim (ftype (function (T) (unsigned-byte 128)) long-float-bits)) 297 | (defun long-float-bits (float) 298 | (declare (ignorable float)) 299 | #+ecl-float-bit-translations 300 | (si:long-float-bits float) 301 | #-(or ecl-float-bit-translations) 302 | (error "Implementation not supported.")) 303 | 304 | (declaim (ftype (function (T) single-float) bits-single-float)) 305 | (defun bits-single-float (bits) 306 | #+abcl 307 | (system:make-single-float bits) 308 | #+allegro 309 | (excl:shorts-to-single-float (ldb (byte 16 16) bits) (ldb (byte 16 0) bits)) 310 | #+ccl 311 | (ccl::host-single-float-from-unsigned-byte-32 bits) 312 | #+clasp 313 | (ext:bits-to-single-float bits) 314 | #+cmucl 315 | (flet ((s32 (x) 316 | (logior x (- (mask-field (byte 1 31) x))) )) 317 | (kernel:make-single-float (s32 bits))) 318 | #+ecl-float-bit-translations 319 | (si:bits-single-float bits) 320 | #+lispworks 321 | (let ((v (sys:make-typed-aref-vector 4))) 322 | (declare (optimize speed (float 0) (safety 0))) 323 | (declare (dynamic-extent v)) 324 | (setf (sys:typed-aref '(unsigned-byte 32) v 0) bits) 325 | (sys:typed-aref 'single-float v 0)) 326 | #+mezzano 327 | (mezzano.extensions:ieee-binary32-to-single-float bits) 328 | #+sbcl 329 | (sb-kernel:make-single-float 330 | (sb-c::mask-signed-field 32 (the (unsigned-byte 32) bits))) 331 | #-(or abcl allegro ccl clasp cmucl ecl-float-bit-translations lispworks mezzano sbcl) 332 | (progn bits (error "Implementation not supported."))) 333 | 334 | (declaim (ftype (function (T) short-float) bits-short-float)) 335 | (defun bits-short-float (bits) 336 | (declare (ignorable bits)) 337 | #+mezzano 338 | (mezzano.extensions:ieee-binary16-to-short-float bits) 339 | #+(or ecl sbcl cmucl allegro ccl (and 64-bit lispworks)) 340 | (let ((sign (ldb (byte 1 15) bits)) 341 | (exp (ldb (byte 5 10) bits)) 342 | (sig (ldb (byte 10 0) bits))) 343 | (if (= exp 31) 344 | (cond 345 | ((not (zerop sig)) 346 | ;; NaNs 347 | (bits-single-float 348 | (logior (ash sign 31) 349 | (ash #xff 23) 350 | ;; store in high-bit to preserve quiet/signalling 351 | (ash sig 13)))) 352 | ;; infinities 353 | ((zerop sign) 354 | single-float-positive-infinity) 355 | (t 356 | single-float-negative-infinity)) 357 | (cond 358 | ((= 0 exp sig) 359 | ;; +- 0 360 | (if (zerop sign) 0s0 -0s0)) 361 | ((zerop exp) 362 | ;; denormals -> single floats 363 | (let ((d (- 11 (integer-length sig)))) 364 | (setf exp (- -14 d)) 365 | (setf sig (ldb (byte 11 0) (ash sig (1+ d)))) 366 | (bits-single-float 367 | (logior (ash sign 31) 368 | (ash (+ exp 127) 23) 369 | (ash sig #.(- 23 11)))))) 370 | (t 371 | ;; normal numbers 372 | (bits-single-float 373 | (logior (ash sign 31) 374 | (ash (+ exp #.(+ 127 -15)) 23) 375 | (ash sig #.(- 23 10)))))))) 376 | #-(or allegro ccl cmucl ecl mezzano sbcl (and 64-bit lispworks)) 377 | (progn bits (error "Implementation not supported."))) 378 | 379 | (declaim (ftype (function (T) double-float) bits-double-float)) 380 | (defun bits-double-float (bits) 381 | #+abcl 382 | (system:make-double-float bits) 383 | #+allegro 384 | (excl:shorts-to-double-float 385 | (ldb (byte 16 48) bits) (ldb (byte 16 32) bits) (ldb (byte 16 16) bits) (ldb (byte 16 0) bits)) 386 | #+ccl 387 | (ccl::double-float-from-bits (ldb (byte 32 32) bits) (ldb (byte 32 0) bits)) 388 | #+clasp 389 | (ext:bits-to-double-float bits) 390 | #+cmucl 391 | (flet ((s32 (x) 392 | (logior x (- (mask-field (byte 1 31) x))) )) 393 | (kernel:make-double-float (s32 (ldb (byte 32 32) bits)) 394 | (ldb (byte 32 0) bits))) 395 | #+ecl-float-bit-translations 396 | (si:bits-double-float bits) 397 | #+lispworks 398 | (let ((v (sys:make-typed-aref-vector 8))) 399 | (declare (optimize speed (float 0) (safety 0))) 400 | (declare (dynamic-extent v)) 401 | #+64-bit (setf (sys:typed-aref '(unsigned-byte 64) v 0) bits) 402 | #+(and :32-bit (not :big-endian)) (setf (sys:typed-aref '(unsigned-byte 32) v 0) (ldb (byte 32 0) bits) 403 | (sys:typed-aref '(unsigned-byte 32) v 4) (ldb (byte 32 32) bits)) 404 | #+(and :32-bit :big-endian) (setf (sys:typed-aref '(unsigned-byte 32) v 4) (ldb (byte 32 0) bits) 405 | (sys:typed-aref '(unsigned-byte 32) v 0) (ldb (byte 32 32) bits)) 406 | (sys:typed-aref 'double-float v 0)) 407 | #+mezzano 408 | (mezzano.extensions:ieee-binary64-to-double-float bits) 409 | #+sbcl 410 | (sb-kernel:make-double-float 411 | (sb-c::mask-signed-field 32 (ldb (byte 32 32) (the (unsigned-byte 64) bits))) 412 | (ldb (byte 32 0) bits)) 413 | #-(or abcl allegro ccl clasp cmucl ecl-float-bit-translations lispworks mezzano sbcl) 414 | (progn bits (error "Implementation not supported."))) 415 | 416 | (declaim (ftype (function (T) long-float) bits-long-float)) 417 | (defun bits-long-float (bits) 418 | (declare (ignorable bits)) 419 | #+ecl-float-bit-translations 420 | (si:bits-long-float bits) 421 | #-(or ecl-float-bit-translations) 422 | (error "Implementation not supported.")) 423 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | Float Features

float features

1.0.0

A portability library for IEEE float features not covered by the CL standard.

About Float-Features

This is a wrapper library for IEEE floating point features not present in the Common Lisp standard.

Implementation Support

The following implementations are currently partially or entirely supported:

  • abcl
  • allegro
  • ccl
  • clasp
  • cmucl
  • ecl
  • mezzano
  • mkcl
  • sbcl
  • lispworks

System Information

1.0.0
Yukari Hafner
zlib
https://github.com/Shinmera/float-features

Definition Index

  • FLOAT-FEATURES

    • ORG.SHIRAKUMO.FLOAT-FEATURES
    No documentation provided.
    • EXTERNAL CONSTANT

      DOUBLE-FLOAT-NAN

          Source 
          A positive quiet NaN value with zero-cleared payload for double-floats.
  2 | This value should NOT be used for comparison with a float value for the pupose of testing NaN
  3 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information.
  4 | Comparing this value with other NaN representations via = will fail.
  5 | To test if a number is a NaN, use FLOAT-NAN-P.
  6 | 
  7 | It is supported on implementations which support BITS-DOUBLE-FLOAT.
  8 | 
  9 | Defaults to MOST-POSITIVE-DOUBLE-FLOAT on unsupported implementations.
        • EXTERNAL CONSTANT

          DOUBLE-FLOAT-NEGATIVE-INFINITY

              Source 
              The negative infinity for double-floats.
 10 | 
 11 | Supported on:
 12 | * ABCL
 13 | * ALLEGRO
 14 | * CCL
 15 | * CMUCL
 16 | * ECL
 17 | * LISPWORKS
 18 | * MEZZANO
 19 | * MKCL
 20 | * SBCL
 21 | 
 22 | Defaults to MOST-NEGATIVE-DOUBLE-FLOAT on unsupported implementations.
            • EXTERNAL CONSTANT

              DOUBLE-FLOAT-POSITIVE-INFINITY

                  Source 
                  The positive infinity for double-floats.
 23 | 
 24 | Supported on:
 25 | * ABCL
 26 | * ALLEGRO
 27 | * CCL
 28 | * CMUCL
 29 | * ECL
 30 | * LISPWORKS
 31 | * MEZZANO
 32 | * MKCL
 33 | * SBCL
 34 | 
 35 | Defaults to MOST-POSITIVE-DOUBLE-FLOAT on unsupported implementations.
                • EXTERNAL CONSTANT

                  LONG-FLOAT-NEGATIVE-INFINITY

                      Source 
                      The negative infinity for long-floats.
 36 | 
 37 | Supported on:
 38 | * CCL
 39 | * CMUCL
 40 | * ECL
 41 | * LISPWORKS
 42 | * MEZZANO
 43 | * MKCL
 44 | * SBCL
 45 | 
 46 | Defaults to MOST-NEGATIVE-LONG-FLOAT on unsupported implementations.
                    • EXTERNAL CONSTANT

                      LONG-FLOAT-POSITIVE-INFINITY

                          Source 
                          The positive infinity for long-floats.
 47 | 
 48 | Supported on:
 49 | * CCL
 50 | * CMUCL
 51 | * ECL
 52 | * LISPWORKS
 53 | * MEZZANO
 54 | * MKCL
 55 | * SBCL
 56 | 
 57 | Defaults to MOST-POSITIVE-LONG-FLOAT on unsupported implementations.
                        • EXTERNAL CONSTANT

                          SHORT-FLOAT-NAN

                              Source 
                              A positive quiet NaN value with zero-cleared payload for short-floats.
 58 | This value should NOT be used for comparison with a float value for the pupose of testing NaN
 59 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information.
 60 | Comparing this value with other NaN representations via = will fail.
 61 | To test if a number is a NaN, use FLOAT-NAN-P.
 62 | 
 63 | It is supported on implementations which support BITS-SHORT-FLOAT.
 64 | 
 65 | Defaults to MOST-POSITIVE-SHORT-FLOAT on unsupported implementations.
                            • EXTERNAL CONSTANT

                              SHORT-FLOAT-NEGATIVE-INFINITY

                                  Source 
                                  The negative infinity for short-floats.
 66 | 
 67 | Supported on:
 68 | * ALLEGRO
 69 | * CCL
 70 | * CMUCL
 71 | * ECL
 72 | * LISPWORKS
 73 | * MEZZANO
 74 | * MKCL
 75 | * SBCL
 76 | 
 77 | Defaults to MOST-NEGATIVE-SHORT-FLOAT on unsupported implementations.
                                • EXTERNAL CONSTANT

                                  SHORT-FLOAT-POSITIVE-INFINITY

                                      Source 
                                      The positive infinity for short-floats.
 78 | 
 79 | Supported on:
 80 | * ALLEGRO
 81 | * CCL
 82 | * CMUCL
 83 | * ECL
 84 | * LISPWORKS
 85 | * MEZZANO
 86 | * MKCL
 87 | * SBCL
 88 | 
 89 | Defaults to MOST-POSITIVE-SHORT-FLOAT on unsupported implementations.
                                    • EXTERNAL CONSTANT

                                      SINGLE-FLOAT-NAN

                                          Source 
                                          A positive quiet NaN value with zero-cleared payload for single-floats.
 90 | This value should NOT be used for comparison with a float value for the pupose of testing NaN
 91 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information.
 92 | Comparing this value with other NaN representations via = will fail.
 93 | To test if a number is a NaN, use FLOAT-NAN-P.
 94 | 
 95 | It is supported on implementations which support BITS-SINGLE-FLOAT.
 96 | 
 97 | Defaults to MOST-POSITIVE-SINGLE-FLOAT on unsupported implementations.
                                        • EXTERNAL CONSTANT

                                          SINGLE-FLOAT-NEGATIVE-INFINITY

                                              Source 
                                              The negative infinity for single-floats.
 98 | 
 99 | Supported on:
100 | * ABCL
101 | * ALLEGRO
102 | * CCL
103 | * CMUCL
104 | * ECL
105 | * LISPWORKS
106 | * MEZZANO
107 | * MKCL
108 | * SBCL
109 | 
110 | Defaults to MOST-NEGATIVE-SINGLE-FLOAT on unsupported implementations.
                                            • EXTERNAL CONSTANT

                                              SINGLE-FLOAT-POSITIVE-INFINITY

                                                  Source 
                                                  The positive infinity for single-floats.
111 | 
112 | Supported on:
113 | * ABCL
114 | * ALLEGRO
115 | * CCL
116 | * CMUCL
117 | * ECL
118 | * LISPWORKS
119 | * MEZZANO
120 | * MKCL
121 | * SBCL
122 | 
123 | Defaults to MOST-POSITIVE-SINGLE-FLOAT on unsupported implementations.
                                                • EXTERNAL SYMBOL-MACRO

                                                  LONG-FLOAT-NAN

                                                      Source 
                                                      A positive quiet NaN value with zero-cleared payload for long-floats.
124 | This value should NOT be used for comparison with a float value for the pupose of testing NaN
125 | because NaN has unused bits (called payload) which are explicitly allowed to store additional information.
126 | Comparing this value with other NaN representations via = will fail.
127 | To test if a number is a NaN, use FLOAT-NAN-P.
128 | 
129 | It is supported on implementations which support BITS-LONG-FLOAT.
130 | 
131 | Defaults to MOST-POSITIVE-LONG-FLOAT on unsupported implementations.
                                                    • EXTERNAL FUNCTION

                                                      BITS-DOUBLE-FLOAT

                                                        • BITS
                                                        Source 
                                                        Encodes the (unsigned-byte 64) bit representation into a native double-float.
132 | 
133 | Supported on:
134 | * ABCL
135 | * ALLEGRO
136 | * CCL
137 | * CLASP
138 | * CMUCL
139 | * LISPWORKS
140 | * MEZZANO
141 | * SBCL
142 | 
143 | Defaults to signalling an error on unsupported implementations.
                                                      • EXTERNAL FUNCTION

                                                        BITS-LONG-FLOAT

                                                          • BITS
                                                          Source 
                                                          Encodes the (unsigned-byte 128) bit representation into a native long-float.
144 | 
145 | Supported on:
146 | 
147 | Defaults to signalling an error on unsupported implementations.
                                                        • EXTERNAL FUNCTION

                                                          BITS-SHORT-FLOAT

                                                            • BITS
                                                            Source 
                                                            Encodes the (unsigned-byte 16) bit representation into a native short-float.
148 | 
149 | Supported on:
150 | * MEZZANO
151 | 
152 | Supported (with 32bit short-float = single-float) on:
153 | * ALLEGRO
154 | * CCL
155 | * CMUCL
156 | * ECL
157 | * LISPWORKS (64-bit only. on 32-bit lw, short-float is not 16 or 32 bits)
158 | * SBCL
159 | 
160 | Defaults to signalling an error on unsupported implementations.
                                                          • EXTERNAL FUNCTION

                                                            BITS-SINGLE-FLOAT

                                                              • BITS
                                                              Source 
                                                              Encodes the (unsigned-byte 32) bit representation into a native single-float.
161 | 
162 | Supported on:
163 | * ABCL
164 | * ALLEGRO
165 | * CCL
166 | * CLASP
167 | * CMUCL
168 | * LISPWORKS
169 | * MEZZANO
170 | * SBCL
171 | 
172 | Defaults to signalling an error on unsupported implementations.
                                                            • EXTERNAL FUNCTION

                                                              DOUBLE-FLOAT-BITS

                                                                • FLOAT
                                                                Source 
                                                                Returns the bit representation of the double-float as an (unsigned-byte 64).
173 | 
174 | Supported on:
175 | * ABCL
176 | * ALLEGRO
177 | * CCL
178 | * CLASP
179 | * CMUCL
180 | * LISPWORKS
181 | * MEZZANO
182 | * SBCL
183 | 
184 | Defaults to signalling an error on unsupported implementations.
                                                              • EXTERNAL FUNCTION

                                                                FLOAT-INFINITY-P

                                                                  • FLOAT
                                                                  Source 
                                                                  Returns T if the given float is an infinity, NIL otherwise.
185 | 
186 | Supported on:
187 | * ABCL
188 | * ALLEGRO
189 | * CCL
190 | * CMUCL
191 | * ECL
192 | * LISPWORKS
193 | * MEZZANO
194 | * SBCL
195 | 
196 | Defaults to comparing against the individual constants on unsupported
197 | implementations.
                                                                • EXTERNAL FUNCTION

                                                                  FLOAT-NAN-P

                                                                    • FLOAT
                                                                    Source 
                                                                    Returns T if the given float is in not-a-number state, NIL otherwise.
198 | 
199 | Supported on:
200 | * ABCL
201 | * ALLEGRO
202 | * CCL
203 | * CMUCL
204 | * ECL
205 | * LISPWORKS
206 | * MEZZANO
207 | * SBCL
208 | 
209 | Defaults to returning NIL on unsupported implementations.
                                                                  • EXTERNAL FUNCTION

                                                                    LONG-FLOAT-BITS

                                                                      • FLOAT
                                                                      Source 
                                                                      Returns the bit representation of the long-float as an (unsigned-byte 128).
210 | 
211 | Supported on:
212 | 
213 | Defaults to signalling an error on unsupported implementations.
                                                                    • EXTERNAL FUNCTION

                                                                      SHORT-FLOAT-BITS

                                                                        • FLOAT
                                                                        Source 
                                                                        Returns the bit representation of the short-float as an (unsigned-byte 16).
214 | 
215 | Supported on:
216 | * MEZZANO
217 | 
218 | Supported (with 32bit short-float = single-float) on:
219 | * ALLEGRO
220 | * CCL
221 | * CMUCL
222 | * ECL
223 | * LISPWORKS (64-bit only. on 32-bit lw, short-float is not 16 or 32 bits)
224 | * SBCL
225 | 
226 | On platforms with 32-bit short-float, low bits of significand are
227 | dropped without rounding, and out of range exponents are converted to
228 | infinities. All values returned by bits-short-float should convert
229 | back to the same bits.
230 | 
231 | Defaults to signalling an error on unsupported implementations.
                                                                      • EXTERNAL FUNCTION

                                                                        SINGLE-FLOAT-BITS

                                                                          • FLOAT
                                                                          Source 
                                                                          Returns the bit representation of the single-float as an (unsigned-byte 32).
232 | 
233 | Supported on:
234 | * ABCL
235 | * ALLEGRO
236 | * CCL
237 | * CLASP
238 | * CMUCL
239 | * LISPWORKS
240 | * MEZZANO
241 | * SBCL
242 | 
243 | Defaults to signalling an error on unsupported implementations.
                                                                        • EXTERNAL MACRO

                                                                          WITH-FLOAT-TRAPS-MASKED

                                                                            • TRAPS
                                                                            • &BODY
                                                                            • BODY
                                                                            Source 
                                                                            Attempts to mask the given floating point traps.
244 | 
245 | Masking a floating point trap causes the given floating point exception
246 | to not signal a condition in the lisp world, and instead lets the
247 | operation return a float that is either a NaN or an infinity.
248 | 
249 | The following traps are recognised:
250 | 
251 |   :underflow
252 |   :overflow
253 |   :inexact
254 |   :invalid 
255 |   :divide-by-zero
256 |   :denormalized-operand
257 | 
258 | The traps argument may be either a list of the above trap identifiers,
259 | or T to signify all maskable traps.
260 | 
261 | Note that not all implementations will signal conditions on all of the
262 | above floating point traps anyway, and some implementations may only
263 | support masking some of the above traps.
264 | 
265 | Supported on:
266 | * ABCL (:overflow :underflow)
267 | * CCL (:overflow :underflow :inexact :invalid :divide-by-zero)
268 | * CLISP (:underflow)
269 | * CMUCL T
270 | * ECL (:underflow :overflow :inexact :invalid :divide-by-zero)
271 | * MEZZANO T
272 | * SBCL T
273 | 
274 | Defaults to a progn on unsupported implementations and ignores
275 | unsupported traps.
                                                                          • EXTERNAL MACRO

                                                                            WITH-ROUNDING-MODE

                                                                              • MODE
                                                                              • &BODY
                                                                              • BODY
                                                                              Source 
                                                                              Temporarily set rounding mode when execute body.
276 | 
277 | The following modes are recognised:
278 | 
279 |   :nearest Round to nearest, ties to even
280 |   :positive Round toward positive infinity
281 |   :negative Round toward negative infinity
282 |   :zero Round toward zero
283 | 
284 | Note that many compilers would by default try to fold floating point
285 | expressions into constants before the rounding mode can take effect.
286 | It is advisory to check disassembled functions to see if that is the
287 | case when the result is not expected.
288 | 
289 | Supported on:
290 | * CCL
291 | * CMUCL
292 | * MEZZANO
293 | * SBCL
294 | 
295 | Signals an error on unsupported implementations.
                                                                          --------------------------------------------------------------------------------