quaviver: Add float128 support

s-expressionists · Jul 3, 2024 · 2dac1bc · 2dac1bc
1 parent fedecf6
commit 2dac1bc
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 17 deletions.
diff --git a/code/float-bits.lisp b/code/float-bits.lisp
@@ -80,9 +80,7 @@
   (ffi:with-foreign-object (v 'long-float/uint128)
     (setf (ffi:get-slot-value v 'long-float/uint128 'f) value)
     (let ((u (ffi:get-slot-value v 'long-float/uint128 'u)))
-      (ldb (byte #+x86-64 80
-                 #-x86-64 128
-                 0)
+      (ldb (byte (quaviver:storage-size 'long-float) 0)
            (logior (ffi:deref-array u '(:array :uint64-t 2) 0)
                    (ash (ffi:deref-array u '(:array :uint64-t 2) 1)
                         64))))))

diff --git a/code/packages.lisp b/code/packages.lisp
@@ -27,4 +27,8 @@
            #:arithmetic-size))
 
 #+(and ecl long-float)
-(pushnew :quaviver/long-float *features*)
+(progn
+  (pushnew :quaviver/long-float *features*)
+  (ecase (float-digits 0l0)
+    (64 (pushnew :quaviver/long-float/x86-extended *features*))
+    (113 (pushnew :quaviver/long-float/binary128 *features*))))
diff --git a/code/traits.lisp b/code/traits.lisp
@@ -129,52 +129,63 @@
   64)
 
 (defmethod storage-size ((type (eql 'long-float)))
-  #+quaviver/long-float 80
+  #+quaviver/long-float/x86-extended 80
+  #+quaviver/long-float/binary128 128
   #-quaviver/long-float 64)
 
 (defmethod significand-bytespec ((type (eql 'long-float)))
-  #+quaviver/long-float (byte 64 0)
+  #+quaviver/long-float/x86-extended (byte 64 0)
+  #+quaviver/long-float/binary128 (byte 112 0)
   #-quaviver/long-float (byte 52 0))
 
 (defmethod significand-byte-form ((type (eql 'long-float)))
-  #+quaviver/long-float `(byte 64 0)
+  #+quaviver/long-float/x86-extended `(byte 64 0)
+  #+quaviver/long-float/binary128 `(byte 112 0)
   #-quaviver/long-float `(byte 52 0))
 
 (defmethod exponent-bytespec ((type (eql 'long-float)))
-  #+quaviver/long-float (byte 15 64)
+  #+quaviver/long-float/x86-extended (byte 15 64)
+  #+quaviver/long-float/binary128 (byte 15 112)
   #-quaviver/long-float (byte 11 52))
 
 (defmethod exponent-byte-form ((type (eql 'long-float)))
-  #+quaviver/long-float `(byte 15 64)
+  #+quaviver/long-float/x86-extended `(byte 15 64)
+  #+quaviver/long-float/binary128 `(byte 15 112)
   #-quaviver/long-float `(byte 11 52))
 
 (defmethod sign-bytespec ((type (eql 'long-float)))
-  #+quaviver/long-float (byte 1 79)
+  #+quaviver/long-float/x86-extended (byte 1 79)
+  #+quaviver/long-float/binary128 (byte 1 127)
   #-quaviver/long-float (byte 1 63))
 
 (defmethod sign-byte-form ((type (eql 'long-float)))
-  #+quaviver/long-float `(byte 1 79)
+  #+quaviver/long-float/x86-extended `(byte 1 79)
+  #+quaviver/long-float/binary128 `(byte 1 127)
   #-quaviver/long-float `(byte 1 63))
 
 (defmethod nan-payload-bytespec ((type (eql 'long-float)))
-  #+quaviver/long-float (byte 63 0)
+  #+quaviver/long-float/x86-extended (byte 63 0)
+  #+quaviver/long-float/binary128 (byte 111 0)
   #-quaviver/long-float (byte 51 0))
 
 (defmethod nan-payload-byte-form ((type (eql 'long-float)))
-  #+quaviver/long-float `(byte 63 0)
+  #+quaviver/long-float/x86-extended `(byte 63 0)
+  #+quaviver/long-float/binary128 `(byte 111 0)
   #-quaviver/long-float `(byte 51 0))
 
 (defmethod nan-type-bytespec ((type (eql 'long-float)))
-  #+quaviver/long-float (byte 1 63)
+  #+quaviver/long-float/x86-extended (byte 1 63)
+  #+quaviver/long-float/binary128 (byte 1 111)
   #-quaviver/long-float (byte 1 51))
 
 (defmethod nan-type-byte-form ((type (eql 'long-float)))
-  #+quaviver/long-float `(byte 1 63)
+  #+quaviver/long-float/x86-extended `(byte 1 63)
+  #+quaviver/long-float/binary128 `(byte 1 111)
   #-quaviver/long-float `(byte 1 51))
 
 (defmethod hidden-bit-p ((type (eql 'long-float)))
-  #+quaviver/long-float nil
-  #-quaviver/long-float t)
+  #+quaviver/long-float/x86-extended nil
+  #-quaviver/long-float/x86-extended t)
 
 (defmethod arithmetic-size ((type (eql 'long-float)))
   #+quaviver/long-float 128