liebler: Initial implementation of integer-float

* extend tables in math
* fix subnormal bug in integer-float base 2

code/integer-float-2.lisp

@@ -51,18 +51,18 @@
  ,significand ,exponent
  ,significand-size ,exponent-size))
  (incf ,exponent ,exponent-bias)
- (cond ((minusp ,exponent) ; Unadjusted subnormal
+ (cond ((plusp ,exponent)
+ (setf (ldb (byte ,significand-size 0) ,bits-var)
+ ,significand
+ (ldb (byte ,exponent-size ,significand-size) ,bits-var)
+ ,exponent))
+ (t ; Unadjusted subnormal
  (setf (ldb (byte (+ ,significand-size ,exponent)
  0)
  ,bits-var)
  (ldb (byte (+ ,significand-size ,exponent)
  (- 1 ,exponent))
- ,significand)))
- (t
- (setf (ldb (byte ,significand-size 0) ,bits-var)
- ,significand
- (ldb (byte ,exponent-size ,significand-size) ,bits-var)
- ,exponent)))))))
+ ,significand))))))))
  ,@forms))))
 
 (declaim (inline ub32-sb32))

code/liebler/implementation.lisp

@@ -0,0 +1,44 @@
+(in-package #:quaviver/liebler)
+
+(defclass client ()
+ ())
+
+(defmacro %liebler (client result-type significand exponent sign bits significand-size expt10 round-to-odd)
+ `(if (or (not (numberp ,exponent))
+ (zerop ,significand))
+ (values ,significand ,exponent ,sign)
+ (let ((k (quaviver/math:floor-log2-expt10 ,exponent))
+ (shift (- ,bits (integer-length ,significand))))
+ (setf ,significand (,round-to-odd (,expt10 (- ,exponent))
+ (ash ,significand shift))
+ k (- k -1 shift)
+ shift (- ,significand-size (integer-length ,significand)))
+ (quaviver:integer-float ,client ,result-type 2
+ (round ,significand (ash 1 (- shift)))
+ (- k shift)
+ ,sign))))
+
+(defmethod quaviver:integer-float
+ ((client client) (result-type (eql 'single-float)) (base (eql 10)) significand exponent sign)
+ (%liebler client result-type
+ significand exponent sign
+ 32 24
+ quaviver/math:expt10/32
+ quaviver/math:round-to-odd/32))
+
+(defmethod quaviver:integer-float
+ ((client client) (result-type (eql 'double-float)) (base (eql 10)) significand exponent sign)
+ (%liebler client result-type
+ significand exponent sign
+ 64 53
+ quaviver/math:expt10/64
+ quaviver/math:round-to-odd/64))
+
+#+quaviver/long-float
+(defmethod quaviver:integer-float
+ ((client client) (result-type (eql 'long-float)) (base (eql 10)) significand exponent sign)
+ (%liebler client result-type
+ significand exponent sign
+ 128 64
+ quaviver/math:expt10/128
+ quaviver/math:round-to-odd/128))

code/liebler/packages.lisp

@@ -0,0 +1,3 @@
+(cl:defpackage #:quaviver/liebler
+ (:use #:common-lisp)
+ (:export #:client))

code/math/implementation.lisp

@@ -42,7 +42,7 @@
 (defun round-to-odd/128 (g cp)
  (%round-to-odd-2 g cp 128))
 
-(defconstant +expt10/min-exponent/32+ -31)
+(defconstant +expt10/min-exponent/32+ -53)
 
 (defconstant +expt10/max-exponent/32+ 53)
 
@@ -53,7 +53,7 @@
  (svref *expt10/values/32*
  (- (- +expt10/min-exponent/32+) power)))
 
-(defconstant +expt10/min-exponent/64+ -292)
+(defconstant +expt10/min-exponent/64+ -342)
 
 (defconstant +expt10/max-exponent/64+ 342)
 
@@ -64,7 +64,7 @@
  (svref *expt10/values/64*
  (- (- +expt10/min-exponent/64+) power)))
 
-(defconstant +expt10/min-exponent/128+ -4913)
+(defconstant +expt10/min-exponent/128+ -5023)
 
 (defconstant +expt10/max-exponent/128+ 5023)
 

quaviver.asd

@@ -137,6 +137,22 @@
  :components ((:file "packages")
  (:file "implementation")))))
 
+(defsystem "quaviver/liebler"
+ :description "Liebler algorithm for Quaviver"
+ :license "MIT"
+ :author ("Tarn W. Burton")
+ :version (:read-file-form "version.sexp")
+ :homepage "https://github.com/s-expressionists/Quaviver"
+ :bug-tracker "https://github.com/s-expressionists/Quaviver/issues"
+ :source-control (:git "https://github.com/s-expressionists/Quaviver.git")
+ :depends-on ("quaviver"
+ "quaviver/math")
+ :components ((:module "code"
+ :pathname "code/liebler/"
+ :serial t
+ :components ((:file "packages")
+ (:file "implementation")))))
+
 (defsystem "quaviver/ansi-test"
  :description "ANSI Test system for Quaviver"
  :license "MIT"