jaffer: fix some bugs

s-expressionists · Jun 27, 2024 · ef62339 · ef62339
1 parent 4d9cf40
commit ef62339
Showing 1 changed file with 7 additions and 6 deletions.
diff --git a/code/jaffer/implementation.lisp b/code/jaffer/implementation.lisp
@@ -15,18 +15,19 @@
  (bex (- (integer-length ,significand)
  (integer-length scale)
  ,significand-size))
- (tmp (+ bex ,exponent 1021 ,significand-size)))
+ (tmp (+ bex ,exponent 1021 ,significand-size))
+ (mantlen ,significand-size))
  (when (minusp tmp)
  (decf bex (1+ tmp))
- (setf scale (ash scale 1)))
+ (incf mantlen tmp))
  (let* ((num (ash ,significand (- bex)))
  (quotient (round num scale)))
- (when (> (integer-length quotient) ,significand-size)
+ (when (> (integer-length quotient) mantlen)
  (incf bex)
- (setf quotient (round num (ash scale 2))))
+ (setf quotient (round num (ash scale 1))))
  (scale-float (coerce quotient ',result-type) (+ bex exponent))))
- (let ((num (* ,significand (expt 5 ,exponent)))
- (bex (- (integer-length ,significand-size))))
+ (let* ((num (* ,significand (expt 5 ,exponent)))
+  (bex (- (integer-length num) ,significand-size)))
  (if (plusp bex)
  (scale-float (coerce (round num (ash 1 bex)) ',result-type)
  (+ bex exponent))