mirror of
https://gitlab.com/eql/lqml.git
synced 2025-12-06 02:30:38 -08:00
76 lines
2.9 KiB
Diff
76 lines
2.9 KiB
Diff
diff --git a/_float-features.lisp b/float-features.lisp
|
|
index b377c0d..6d56968 100644
|
|
--- a/_float-features.lisp
|
|
+++ b/float-features.lisp
|
|
@@ -334,6 +334,8 @@
|
|
(ext:single-float-to-bits float)
|
|
#+cmucl
|
|
(ldb (byte 32 0) (kernel:single-float-bits float))
|
|
+ #+ecl
|
|
+ (si:single-float-bits float)
|
|
#+lispworks
|
|
(let ((v (sys:make-typed-aref-vector 4)))
|
|
(declare (optimize (speed 3) (float 0) (safety 0)))
|
|
@@ -344,7 +346,7 @@
|
|
(mezzano.extensions:single-float-to-ieee-binary32 float)
|
|
#+sbcl
|
|
(ldb (byte 32 0) (sb-kernel:single-float-bits float))
|
|
- #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
|
|
+ #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
|
|
(progn float (error "Implementation not supported.")))
|
|
|
|
(declaim (ftype (function (T) (unsigned-byte 64)) double-float-bits))
|
|
@@ -364,6 +366,8 @@
|
|
(ldb (byte 64 0)
|
|
(logior (kernel:double-float-low-bits float)
|
|
(ash (kernel:double-float-high-bits float) 32)))
|
|
+ #+ecl
|
|
+ (si:double-float-bits float)
|
|
#+lispworks
|
|
(let ((v (sys:make-typed-aref-vector 8)))
|
|
(declare (optimize (speed 3) (float 0) (safety 0)))
|
|
@@ -378,7 +382,7 @@
|
|
(ldb (byte 64 0)
|
|
(logior (sb-kernel:double-float-low-bits float)
|
|
(ash (sb-kernel:double-float-high-bits float) 32)))
|
|
- #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
|
|
+ #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
|
|
(progn float (error "Implementation not supported.")))
|
|
|
|
(declaim (ftype (function (T) (unsigned-byte 128)) long-float-bits))
|
|
@@ -447,6 +451,8 @@
|
|
(flet ((s32 (x)
|
|
(logior x (- (mask-field (byte 1 31) x))) ))
|
|
(kernel:make-single-float (s32 bits)))
|
|
+ #+ecl
|
|
+ (si:bits-single-float bits)
|
|
#+lispworks
|
|
(let ((v (sys:make-typed-aref-vector 4)))
|
|
(declare (optimize speed (float 0) (safety 0)))
|
|
@@ -458,7 +464,7 @@
|
|
#+sbcl
|
|
(sb-kernel:make-single-float
|
|
(sb-c::mask-signed-field 32 (the (unsigned-byte 32) bits)))
|
|
- #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
|
|
+ #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
|
|
(progn bits (error "Implementation not supported.")))
|
|
|
|
(declaim (ftype (function (T) double-float) bits-double-float))
|
|
@@ -477,6 +483,8 @@
|
|
(logior x (- (mask-field (byte 1 31) x))) ))
|
|
(kernel:make-double-float (s32 (ldb (byte 32 32) bits))
|
|
(ldb (byte 32 0) bits)))
|
|
+ #+ecl
|
|
+ (si:bits-double-float bits)
|
|
#+lispworks
|
|
(let ((v (sys:make-typed-aref-vector 8)))
|
|
(declare (optimize speed (float 0) (safety 0)))
|
|
@@ -491,7 +499,7 @@
|
|
(sb-kernel:make-double-float
|
|
(sb-c::mask-signed-field 32 (ldb (byte 32 32) (the (unsigned-byte 64) bits)))
|
|
(ldb (byte 32 0) bits))
|
|
- #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
|
|
+ #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
|
|
(progn bits (error "Implementation not supported.")))
|
|
|
|
(declaim (ftype (function (T) long-float) bits-long-float))
|