quaviver, liebler: Use bounds checking instead of typep

s-expressionists · Aug 19, 2024 · 7e69d0c · 7e69d0c
1 parent 444793d
commit 7e69d0c
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 16 deletions.
diff --git a/code/liebler/implementation.lisp b/code/liebler/implementation.lisp
@@ -19,14 +19,14 @@
          (cond ((or (keywordp ,exponent-var)
                     (zerop ,significand-var))
                 ,(quaviver:primitive-triple-float-form float-type significand-var exponent-var sign-var))
-               ((not (typep ,exponent-var 'quaviver:exponent-word))
-                (if (minusp ,exponent-var)
-                    (quaviver.condition:floating-point-underflow
-                     'triple-float
-                     ,significand-var ,exponent-var ,sign-var)
-                    (quaviver.condition:floating-point-overflow
-                     'triple-float
-                     ,significand-var ,exponent-var ,sign-var)))
+               ((< ,exponent-var ,(- (expt 2 21)))
+                (quaviver.condition:floating-point-underflow
+                 'triple-float
+                 ,significand-var ,exponent-var ,sign-var))
+               ((> ,exponent-var ,(1- (expt 2 21)))
+                (quaviver.condition:floating-point-overflow
+                 'triple-float
+                 ,significand-var ,exponent-var ,sign-var))
                (t
                 (let* ((shift (- ,significand-size (integer-length ,significand-var)))
                        (k (- (quaviver.math:floor-log-expt 2 10 ,exponent-var) -1 shift)))

diff --git a/code/primitive-triple-float-form.lisp b/code/primitive-triple-float-form.lisp
@@ -50,14 +50,14 @@
                    (setf (ldb ,nan-payload-byte-form ,bits-var)
                          (if (zerop ,significand-var) 1 ,significand-var)))))
                ((zerop ,significand-var))
-               ((not (typep ,exponent-var 'exponent-word))
-                (if (minusp ,exponent-var)
-                    (quaviver.condition:floating-point-underflow
-                     'triple-float
-                     ,significand-var ,exponent-var ,sign-var)
-                    (quaviver.condition:floating-point-overflow
-                     'triple-float
-                     ,significand-var ,exponent-var ,sign-var)))
+               ((< ,exponent-var ,(- (expt 2 21)))
+                (quaviver.condition:floating-point-underflow
+                 'triple-float
+                 ,significand-var ,exponent-var ,sign-var))
+               ((> ,exponent-var ,(1- (expt 2 21)))
+                (quaviver.condition:floating-point-overflow
+                 'triple-float
+                 ,significand-var ,exponent-var ,sign-var))
                (t
                 (let ((shift (- ,significand-size
                                 (integer-length ,significand-var))))