From 28d94255506afa0fab04cd5c6e7433c134cad215 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Thu, 20 Jun 2024 09:32:22 -0400 Subject: [PATCH] quaviver, schubfach, benchmark: check for long-float support --- code/benchmark/float-integer.lisp | 129 ++++++++++++++++------------- code/float-integer-2.lisp | 2 +- code/packages.lisp | 10 +++ code/schubfach/implementation.lisp | 2 +- 4 files changed, 82 insertions(+), 61 deletions(-) diff --git a/code/benchmark/float-integer.lisp b/code/benchmark/float-integer.lisp index e847d176..b821c574 100644 --- a/code/benchmark/float-integer.lisp +++ b/code/benchmark/float-integer.lisp @@ -1,83 +1,94 @@ (cl:in-package #:quaviver/benchmark) +(defvar *tests* + (list `(:type single-float :limit ,most-positive-single-float) + `(:type double-float :limit ,most-positive-double-float) + #+quaviver/long-float + `(:type long-float :limit ,most-positive-long-float))) + (defvar *clients* - `((:label "Burger-Dybvig" :initargs (quaviver/burger-dybvig:client)) - (:label "Schubfach" :initargs (quaviver/schubfach:client)) + `((:label "Burger-Dybvig" + :initargs (quaviver/burger-dybvig:client) + :types (single-float double-float long-float)) + (:label "Schubfach" + :initargs (quaviver/schubfach:client) + :types (single-float double-float long-float)) #+(or abcl ccl clasp cmucl ecl sbcl) (:label ,(format nil "Native (~a)" (lisp-implementation-type)) - :initargs (quaviver/native:benchmark-client)))) + :initargs (quaviver/native:benchmark-client) + :types (single-float double-float long-float)))) (defun float-integer (&optional (base 10)) (labels ((bench (clients limit key) (mapcar (lambda (properties &aux (client (apply #'make-instance (getf properties :initargs)))) - ;; Do one conversion in case there is some initialization needed. - (quaviver:float-integer client base (random limit)) - (list* key - (the-cost-of-nothing:benchmark - (quaviver:float-integer client - base - (* (1- (ash (random 2) 1)) - (random limit)))) - properties)) + (cond ((member key (getf properties :types)) + ;; Do one conversion in case there is some initialization needed. + (quaviver:float-integer client base (random limit)) + (list* key + (the-cost-of-nothing:benchmark + (quaviver:float-integer client + base + (* (1- (ash (random 2) 1)) + (random limit)))) + properties)) + (t + properties))) clients)) (plot (title results key) (write-string (cl-spark:vspark - (mapcar (lambda (properties) - (getf properties key)) + (mapcan (lambda (properties + &aux (value (getf properties key))) + (when value + (list value))) results) :title title :min 0 :size 132 - :labels (mapcar (lambda (client) - (getf client :label)) + :labels (mapcan (lambda (client) + (when (getf client key) + (list (getf client :label)))) results))))) (let ((results *clients*) - (table (ascii-table:make-table '("client" - " absolute single-float" - "relative single-float" - " absolute 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)) + (table (ascii-table:make-table + (list* "client" + (loop for test in *tests* + for type = (getf test :type) + collect (format nil "~21@a" + (format nil "absolute ~(~a~)" type)) + collect (format nil "~21@a" + (format nil "relative ~(~a~)" type))))))) + (loop for test in *tests* + for type = (getf test :type) + for limit = (getf test :limit) + do (setf results (bench results limit type)) + (plot (format nil "float-integer ~(~a~)" type) + results type) + (terpri)) + (loop with mins = (loop for test in *tests* + for type = (getf test :type) + collect type + collect (loop for result in results + for value = (getf result type) + when value + minimize value)) 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)) - #+(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))))) + do (ascii-table:add-row table (list* (getf result :label) + (loop for test in *tests* + for type = (getf test :type) + for value = (getf result type) + when value + collect (format nil "~21,15g" + (getf result type)) + and collect (format nil "~21,15f" + (/ (getf result type) + (getf mins type))) + else + collect (make-string 21 + :initial-element #\space) + and collect (make-string 21 + :initial-element #\space))))) (ascii-table:display table)))) diff --git a/code/float-integer-2.lisp b/code/float-integer-2.lisp index c0aaf9a7..0bf49d00 100644 --- a/code/float-integer-2.lisp +++ b/code/float-integer-2.lisp @@ -109,7 +109,7 @@ :hidden-bit t :exponent-bias 1075)) -#+(and ecl long-float) +#+quaviver/long-float (defmethod float-integer (client (base (eql 2)) (value long-float)) (declare (ignore client)) (%integer-decode-float diff --git a/code/packages.lisp b/code/packages.lisp index 33c70bf8..6bd6b3a9 100644 --- a/code/packages.lisp +++ b/code/packages.lisp @@ -6,3 +6,13 @@ #:float-integer #:digits-integer #:integer-digits)) + +#+(and ecl long-float) +(eval-when (:compile-toplevel :load-toplevel :execute) + (handler-case + (system:long-float-bits 0l0) + (error (condition) + (declare (ignore condition))) + (:no-error (result) + (declare (ignore result)) + (pushnew :quaviver/long-float *features*)))) diff --git a/code/schubfach/implementation.lisp b/code/schubfach/implementation.lisp index ff3b101e..ae115ba1 100644 --- a/code/schubfach/implementation.lisp +++ b/code/schubfach/implementation.lisp @@ -83,7 +83,7 @@ quaviver/math:expt10/64 quaviver/math:round-to-odd/64)) -#+(and ecl long-float) +#+quaviver/long-float (defmethod quaviver:float-integer ((client client) (base (eql 10)) (value long-float)) (%schubfach client value 128 64