quaviver: Add Clasp long-float/short-float

s-expressionists · Sep 26, 2024 · 99e04a3 · 99e04a3
1 parent 9f84ed0
commit 99e04a3
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 7 deletions.
diff --git a/code/ansi-test/test.lisp b/code/ansi-test/test.lisp
@@ -54,7 +54,7 @@
 (defvar *client-initargs*
   '((burger-dybvig)
     (schubfach)
-    #-ecl (dragonbox)))
+    #-(or ecl (and clasp long-float)) (dragonbox)))
 
 (defun test (&rest args &key exit &allow-other-keys)
   (setf args (remprop :exit args))

diff --git a/code/bits-float-form.lisp b/code/bits-float-form.lisp
@@ -17,6 +17,8 @@
 
 #+quaviver/short-float
 (defmethod bits-float-form ((float-type (eql 'short-float)) value)
+  #+clasp
+  `(ext:bits-to-short-float ,value)
   #+clisp
   `(ffi:with-foreign-object (u '(ffi:c-union (value ffi:single-float)
                                              (bits  ffi:uint32)))
@@ -126,9 +128,11 @@
 
 #+quaviver/long-float
 (defmethod bits-float-form ((float-type (eql 'long-float)) value)
-  #-quaviver/long-float-fallback
+  #+clasp
+  `(ext:bits-to-long-float ,value)
+  #+(and ecl (not quaviver/long-float-fallback))
   `(system:bits-long-float ,value)
-  #+quaviver/long-float-fallback
+  #+(and ecl quaviver/long-float-fallback)
   (alexandria:with-gensyms
       (m n v)
     `(let ((,v ,value))

diff --git a/code/float-bits-form.lisp b/code/float-bits-form.lisp
@@ -2,6 +2,8 @@
 
 #+quaviver/short-float
 (defmethod float-bits-form ((float-type (eql 'short-float)) value)
+  #+clasp
+  `(ext:short-float-to-bits ,value)
   #+clisp
   `(ffi:with-foreign-object (u '(ffi:c-union (value ffi:single-float)
                                              (bits  ffi:uint32)))
@@ -107,9 +109,11 @@
 
 #+quaviver/long-float
 (defmethod float-bits-form ((float-type (eql 'long-float)) value)
-  #-quaviver/long-float-fallback
+  #+clasp
+  `(ext:long-float-to-bits ,value)
+  #+(and ecl (not quaviver/long-float-fallback))
   `(system:long-float-bits ,value)
-  #+quaviver/long-float-fallback
+  #+(and ecl quaviver/long-float-fallback)
   (alexandria:with-gensyms
       (m n)
     `(ffi:with-foreign-object (,m 'long-float/uint128)

diff --git a/code/packages.lisp b/code/packages.lisp
@@ -42,10 +42,10 @@
            #:exponent-word
            #:define-number-parser))
 
-#+clisp
+#+(or clisp (and clasp short-float))
 (pushnew :quaviver/short-float *features*)
 
-#+(and ecl long-float)
+#+(and (or clasp ecl) long-float)
 (pushnew :quaviver/long-float *features*)
 
 (defpackage #:quaviver.math