quaviver, schubfach, math, benchmark: Add 80-bit long-float support

Also automatically compute expt10 tables

code/benchmark/float-decimal.lisp

@@ -34,30 +34,49 @@
  :labels (mapcar (lambda (client)
  (getf client :label))
  results)))))
- (let ((results (bench (bench *clients*
- most-positive-single-float
- :single-time)
- most-positive-double-float
- :double-time))
+ (let ((results *clients*)
  (table (ascii-table:make-table '("client"
  " absolute single-float"
  "relative single-float"
  " absolute double-float"
- "relative double-float"))))
+ "relative double-float"
+ #+(and ecl long-float)
+ " absolute long-float"
+ #+(and ecl long-float)
+ " relative long-float"))))
+ (setf results (bench results
+ most-positive-single-float
+ :single-time))
+ (setf results (bench results
+ most-positive-double-float
+ :double-time))
+ #+(and ecl long-float)
+ (setf results (bench results
+ most-positive-long-float
+ :long-time))
  (plot "float-integer single-float" results :single-time)
  (terpri)
  (plot "float-integer double-float" results :double-time)
  (terpri)
+ #+(and ecl long-float) (plot "float-integer long-float" results :long-time)
+ #+(and ecl long-float) (terpri)
  (loop with min-single = (loop for result in results
  minimize (getf result :single-time))
  with min-double = (loop for result in results
  minimize (getf result :double-time))
+ with min-long = (loop for result in results
+ minimize (getf result :long-time 0))
  for result in results
  do (ascii-table:add-row table (list (getf result :label)
  (format nil "~30g" (getf result :single-time))
  (format nil "~21,15f" (/ (getf result :single-time)
  min-single))
  (format nil "~30g" (getf result :double-time))
  (format nil "~21,15f" (/ (getf result :double-time)
- min-double)))))
+ min-double))
+ #+(and ecl long-float)
+ (format nil "~30g" (getf result :long-time))
+ #+(and ecl long-float)
+ (format nil "~21,15f" (/ (getf result :long-time)
+ min-long)))))
  (ascii-table:display table))))

code/float-integer-2.lisp

@@ -18,17 +18,21 @@
  exponent)
  (type (integer -1 1)
  sign))
- (if (zerop exponent) ; subnormal
- (let ((shift (- ,(if hidden-bit-p (1+ significand-size) significand-size)
- (integer-length significand))))
- (values (ash significand shift)
- (- ,(- 1 exponent-bias) shift)
- sign))
- (values ,(if hidden-bit-p
- `(logior significand ,(ash 1 significand-size))
- 'significand)
- (- exponent ,exponent-bias)
- sign))))
+ (cond ((and (zerop significand)
+ (zerop exponent))
+ (values 0 0 sign))
+ ((zerop exponent) ; subnormal
+ (let ((shift (- ,(if hidden-bit-p (1+ significand-size) significand-size)
+ (integer-length significand))))
+ (values (ash significand shift)
+ (- ,(- 1 exponent-bias) shift)
+ sign)))
+ (t
+ (values ,(if hidden-bit-p
+ `(logior significand ,(ash 1 significand-size))
+ 'significand)
+ (- exponent ,exponent-bias)
+ sign)))))
 
 #-(or abcl allegro clasp cmucl ecl lispworks sbcl)
 (defmethod float-integer (client (base (eql 2)) value)
@@ -98,3 +102,13 @@
  :exponent-size 11
  :hidden-bit t
  :exponent-bias 1075))
+
+#+(and ecl long-float)
+(defmethod float-integer (client (base (eql 2)) (value long-float))
+ (declare (ignore client))
+ (%integer-decode-float
+ (system:long-float-bits value)
+ :significand-size 64
+ :exponent-size 15
+ :hidden-bit nil
+ :exponent-bias 16446))

code/integer-digits.lisp

@@ -92,9 +92,57 @@
  (incf n))
  n))
 
+(defun count-digits/128 (integer)
+ (declare (optimize speed)
+ ((unsigned-byte 128) integer))
+ (let ((n (ash (* 1233 (integer-length integer)) -12)))
+ (when (>= integer (svref #(1
+ 10
+ 100
+ 1000
+ 10000
+ 100000
+ 1000000
+ 10000000
+ 100000000
+ 1000000000
+ 10000000000
+ 100000000000
+ 1000000000000
+ 10000000000000
+ 100000000000000
+ 1000000000000000
+ 10000000000000000
+ 100000000000000000
+ 1000000000000000000
+ 10000000000000000000
+ 100000000000000000000
+ 1000000000000000000000
+ 10000000000000000000000
+ 100000000000000000000000
+ 1000000000000000000000000
+ 10000000000000000000000000
+ 100000000000000000000000000
+ 1000000000000000000000000000
+ 10000000000000000000000000000
+ 100000000000000000000000000000
+ 1000000000000000000000000000000
+ 10000000000000000000000000000000
+ 100000000000000000000000000000000
+ 1000000000000000000000000000000000
+ 10000000000000000000000000000000000
+ 100000000000000000000000000000000000
+ 1000000000000000000000000000000000000
+ 10000000000000000000000000000000000000
+ 100000000000000000000000000000000000000
+ 1000000000000000000000000000000000000000
+ 10000000000000000000000000000000000000000
+ 100000000000000000000000000000000000000000)
+ n))
+ (incf n))
+ n))
+
 (defun digit-vector/32 (value)
- ;; Convert value into digits.
- ;;
  ;; The division by 10 could be optimized by reinterpreting the
  ;; value in fixed point arithmetic with the decimal point to
  ;; the left of the leading digit and multiplying by 10 at each
@@ -112,14 +160,23 @@
 (defun digit-vector/64 (value)
  (declare (optimize speed)
  (type (unsigned-byte 64) value))
- ;; Convert value into digits.
  (loop with digits = (make-array (count-digits/64 value))
  with digit
  for i from (1- (length digits)) downto 0
  finally (return digits)
  do (multiple-value-setq (value digit) (floor value 10))
  (setf (aref digits i) digit)))
 
+(defun digit-vector/128 (value)
+ (declare (optimize speed)
+ (type (unsigned-byte 128) value))
+ (loop with digits = (make-array (count-digits/128 value))
+ with digit
+ for i from (1- (length digits)) downto 0
+ finally (return digits)
+ do (multiple-value-setq (value digit) (floor value 10))
+ (setf (aref digits i) digit)))
+
 (defmethod quaviver:integer-digits
  (client (result-type (eql 'vector)) (base (eql 10)) value)
  (declare (ignore client))
@@ -129,11 +186,11 @@
  ((unsigned-byte 32)
  (digit-vector/32 value))
  ((unsigned-byte 64)
- (digit-vector/64 value)))))
+ (digit-vector/64 value))
+ ((unsigned-byte 128)
+ (digit-vector/128 value)))))
 
 (defun digit-string/32 (value)
- ;; Convert value into string of digits.
- ;;
  ;; The division by 10 could be optimized by reinterpreting the
  ;; value in fixed point arithmetic with the decimal point to
  ;; the left of the leading digit and multiplying by 10 at each
@@ -152,7 +209,6 @@
 (defun digit-string/64 (value)
  (declare (optimize speed)
  (type (unsigned-byte 64) value))
- ;; Convert value into digits.
  (loop with digits = (make-string (count-digits/64 value)
  :element-type 'base-char)
  with digit
@@ -161,6 +217,17 @@
  do (multiple-value-setq (value digit) (floor value 10))
  (setf (aref digits i) (digit-char digit))))
 
+(defun digit-string/128 (value)
+ (declare (optimize speed)
+ (type (unsigned-byte 128) value))
+ (loop with digits = (make-string (count-digits/128 value)
+ :element-type 'base-char)
+ with digit
+ for i from (1- (length digits)) downto 0
+ finally (return digits)
+ do (multiple-value-setq (value digit) (floor value 10))
+ (setf (aref digits i) (digit-char digit))))
+
 (defmethod quaviver:integer-digits
  (client (result-type (eql 'string)) (base (eql 10)) value)
  (declare (ignore client))
@@ -170,7 +237,9 @@
  ((unsigned-byte 32)
  (digit-string/32 value))
  ((unsigned-byte 64)
- (digit-string/64 value)))))
+ (digit-string/64 value))
+ ((unsigned-byte 128)
+ (digit-string/128 value)))))
 
 (defmethod quaviver:integer-digits
  (client (result-type (eql 'list)) base value)

code/integer-float-2.lisp

@@ -9,7 +9,7 @@
  &body body)
  (declare (ignore hidden-bit-p))
  (multiple-value-bind (forms declarations)
- (uiop:parse-body body)
+ (alexandria:parse-body body)
  `(let ((,bits-var (if (minusp sign)
  ,(ash 1 (+ significand-size exponent-size))
  0)))