Skip to content

Commit

Permalink
Update for req changes
Browse files Browse the repository at this point in the history
  • Loading branch information
@yitzchak
yitzchak committed Jul 17, 2024
1 parent ad26ebe commit f9716a8
Show file tree
Hide file tree
Showing 13 changed files with 61 additions and 52 deletions.
8 changes: 4 additions & 4 deletions code/bits-float-form.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,11 +95,11 @@
(declare (optimize (speed 3) (float 0) (safety 0))
(dynamic-extent ,m))
#+little-endian
(setf (sys:typed-aref '(unsigned-byte 32) v 0) (ldb (byte 32 0) ,v)
(sys:typed-aref '(unsigned-byte 32) v 4) (ldb (byte 32 32) ,v))
(setf (sys:typed-aref '(unsigned-byte 32) ,m 0) (ldb (byte 32 0) ,v)
(sys:typed-aref '(unsigned-byte 32) ,m 4) (ldb (byte 32 32) ,v))
#-little-endian
(setf (sys:typed-aref '(unsigned-byte 32) v 0) (ldb (byte 32 32) ,v)
(sys:typed-aref '(unsigned-byte 32) v 4) (ldb (byte 32 0) ,v))
(setf (sys:typed-aref '(unsigned-byte 32) ,m 0) (ldb (byte 32 32) ,v)
(sys:typed-aref '(unsigned-byte 32) ,m 4) (ldb (byte 32 0) ,v))
(sys:typed-aref 'double-float ,m 0)))
#+mezzano
`(mezzano.extensions:ieee-binary64-to-double-float ,value)
Expand Down
2 changes: 1 addition & 1 deletion code/burger-dybvig/implementation.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -275,7 +275,7 @@
(abs (- v low-out)))
(setf result (+ (* 10 result) (1+ d)))
(decf scale))
(t ;; beak the tie
(t ;; break the tie
(setf result (+ (* 10 result) (1+ d)))
(decf scale)))
(loop-finish))
Expand Down
1 change: 1 addition & 0 deletions code/compare/float-integer.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@
result)))
(not result))
(error (condition)
;; the condition is formatted separately to ensure it is READable.
(format stream "~:@<#x~x :error ~s~:@>~%"
(iterator-bits iterator)
(format nil "~a" condition))
Expand Down
1 change: 1 addition & 0 deletions code/compare/integer-float.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@
(not result))
(error (condition)
(declare (ignore condition))
;; the condition is formatted separately to ensure it is READable.
(format stream "~:@<#x~x :error ~s~:@>~%"
(iterator-bits iterator)
(format nil "~a" condition))
Expand Down
8 changes: 4 additions & 4 deletions code/condition/utility.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
(in-package #:quaviver.condition)

(defun float-overflow-error (operation &rest operands)
(error 'floating-point-overflow
(defun floating-point-overflow (operation &rest operands)
(error 'cl:floating-point-overflow
:operation operation
:operands operands))

(defun float-underflow-error (operation &rest operands)
(error 'floating-point-underflow
(defun floating-point-underflow (operation &rest operands)
(error 'cl:floating-point-underflow
:operation operation
:operands operands))
10 changes: 4 additions & 6 deletions code/dragonbox/implementation.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -419,15 +419,14 @@
(multiple-value-bind (significand exponent sign)
,(quaviver:float-internal-integer-form type value)
(declare ((quaviver.math:arithmetic-word ,arithmetic-size) significand)
((or (integer ,min-exponent ,max-exponent) keyword) exponent)
((or quaviver:exponent-word keyword) exponent)
(fixnum sign))
(when (or (keywordp exponent)
(zerop significand))
(return-from %dragonbox
(values significand exponent sign)))
(let ((2fc 0))
(let ((2fc (ash significand 1)))
(declare ((quaviver.math:arithmetic-word ,arithmetic-size) 2fc))
(setf 2fc (ash significand 1))
;; Shorter interval case
;;
;; Reference Dragonbox additionally checks for a normal
Expand Down Expand Up @@ -593,15 +592,14 @@
(multiple-value-bind (significand exponent sign)
,(quaviver:float-internal-integer-form type value)
(declare ((quaviver.math:arithmetic-word ,arithmetic-size) significand)
((or (integer ,min-exponent ,max-exponent) keyword) exponent)
((or quaviver:exponent-word keyword) exponent)
(fixnum sign))
(when (or (keywordp exponent)
(zerop significand))
(return-from %dragonbox
(values significand exponent sign)))
(let ((2fc 0))
(let ((2fc (ash significand 1)))
(declare ((quaviver.math:arithmetic-word ,arithmetic-size) 2fc))
(setf 2fc (ash significand 1))
(ecase (direction ,client sign)
(:left-closed-directed
;; Step 1: Schubfach multiplier calculation
Expand Down
8 changes: 4 additions & 4 deletions code/float-bits-form.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,8 @@
(bits ffi:uint32)))
(setf (ffi:slot (ffi:foreign-value u) 'value) (coerce ,value 'single-float))
(ash (ffi:slot (ffi:foreign-value u) 'bits)
(- (storage-size 'short-float)
(storage-size 'single-float)))))
,(- (storage-size 'short-float)
(storage-size 'single-float)))))

(defmethod float-bits-form ((float-type (eql 'single-float)) value)
#+abcl
Expand Down Expand Up @@ -57,7 +57,7 @@
(us0 (gensym)))
`(multiple-value-bind (,us3 ,us2 ,us1 ,us0)
(excl:double-float-to-shorts ,value)
(logior (ash ,us3 48) (ash ,us2 32) (ash ,us1 16) us0)))
(logior (ash ,us3 48) (ash ,us2 32) (ash ,us1 16) ,us0)))
#+ccl
(let ((upper (gensym))
(lower (gensym)))
Expand Down Expand Up @@ -108,7 +108,7 @@
`(ffi:with-foreign-object (,m 'long-float/uint128)
(setf (ffi:get-slot-value ,m 'long-float/uint128 'f) ,value)
(let ((,n (ffi:get-slot-value ,m 'long-float/uint128 'u)))
(ldb (byte (quaviver:storage-size 'long-float) 0)
(ldb (byte ,(quaviver:storage-size 'long-float) 0)
(logior (ffi:deref-array ,n '(:array :uint64-t 2) 0)
(ash (ffi:deref-array ,n '(:array :uint64-t 2) 1)
64)))))))
8 changes: 4 additions & 4 deletions code/internal-integer-float-form.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,13 +58,13 @@
(setf ,significand-var (ash ,significand-var shift))
(decf ,exponent-var shift))
(cond ((< ,exponent-var ,min-exponent)
(quaviver.condition:float-underflow-error
(quaviver.condition:floating-point-underflow
'integer-float
,significand ,exponent ,sign))
,significand-var ,exponent-var ,sign-var))
((> ,exponent-var ,max-exponent)
(quaviver.condition:float-overflow-error
(quaviver.condition:floating-point-overflow
'integer-float
,significand ,exponent ,sign))
,significand-var ,exponent-var ,sign-var))
(t
(incf ,exponent-var ,exponent-bias)
(cond ((plusp ,exponent-var)
Expand Down
40 changes: 22 additions & 18 deletions code/jaffer/implementation.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,10 @@
float-type
`(if (or (keywordp ,exponent)
(zerop ,significand))
,(quaviver:internal-integer-float-form float-type significand exponent sign)
,(quaviver:internal-integer-float-form float-type
significand
exponent
sign)
(let ((q (+ (quaviver.math:floor-log-expt 2 10 ,exponent)
(integer-length ,significand)
,(- significand-size))))
Expand All @@ -19,16 +22,16 @@
;; large bignum in the intermediate calculations.
(cond ((> q ,(+ max-exponent
(quaviver.math:ceiling-log-expt 2 10 1)))
(error 'floating-point-overflow
:operation 'quaviver:integer-float
:operands (list ,client ',float-type 10
,significand ,exponent nil)))
(quaviver.condition:floating-point-overflow
'quaviver:integer-float
,client ',float-type 10
,significand ,exponent ,sign))
((< q ,(- min-exponent
(quaviver.math:ceiling-log-expt 2 10 1)))
(error 'floating-point-underflow
:operation 'quaviver:integer-float
:operands (list ,client ',float-type 10
,significand ,exponent nil)))
(quaviver.condition:floating-point-underflow
'quaviver:integer-float
,client ',float-type 10
,significand ,exponent ,sign))
((minusp ,exponent)
(let* ((scale (expt 5 (- ,exponent)))
(bex (- (integer-length ,significand)
Expand All @@ -44,21 +47,22 @@
(when (> (integer-length quotient) mantlen)
(incf bex)
(setf quotient (round num (ash scale 1))))
,(quaviver:internal-integer-float-form float-type 'quotient
`(+ bex ,exponent)
sign))))
,(quaviver:internal-integer-float-form float-type
'quotient
`(+ bex ,exponent)
sign))))
(t
(let* ((num (* ,significand (expt 5 ,exponent)))
(bex (- (integer-length num) ,significand-size)))
(if (plusp bex)
,(quaviver:internal-integer-float-form float-type
`(round num (ash 1 bex))
`(+ bex ,exponent)
sign)
`(round num (ash 1 bex))
`(+ bex ,exponent)
sign)
,(quaviver:internal-integer-float-form float-type
'num
exponent
sign)))))))))
'num
exponent
sign)))))))))

#+quaviver/short-float
(defmethod quaviver:integer-float
Expand Down
10 changes: 5 additions & 5 deletions code/liebler/implementation.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,12 +29,12 @@
;; table lookup from an out of bounds error.
(cond ((> k ,(+ max-exponent
(quaviver.math:ceiling-log-expt 2 10 1)))
(quaviver.condition:float-overflow-error
(quaviver.condition:floating-point-overflow
'quaviver:integer-float
,client ',float-type 10 ,significand-var ,exponent-var ,sign-var))
((< k ,(- min-exponent
(quaviver.math:ceiling-log-expt 2 10 1)))
(quaviver.condition:float-underflow-error
(quaviver.condition:floating-point-underflow
'quaviver:integer-float
,client ',float-type 10 ,significand-var ,exponent-var ,sign-var))
(t
Expand All @@ -45,9 +45,9 @@
(- ,exponent-var)))
shift (- ,significand-size (integer-length ,significand-var)))
,(quaviver:internal-integer-float-form float-type
`(round ,significand-var (ash 1 (- shift)))
`(- k shift ,extra)
sign-var)))))))))
`(round ,significand-var (ash 1 (- shift)))
`(- k shift ,extra)
sign-var)))))))))

#+quaviver/short-float
(defmethod quaviver:integer-float
Expand Down
5 changes: 3 additions & 2 deletions code/math/log-expt.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,9 +4,10 @@
*log-expt*)
(type (simple-vector 35)
*log-3/4*)
(ftype (function ((integer 2 36) (integer 2 36) quaviver:exponent-word
(ftype (function ((integer 2 36) (integer 2 36)
quaviver:exponent-word
&optional boolean)
quaviver:exponent-word)
(values quaviver:exponent-word &optional))
floor-log-expt ceiling-log-expt)
(inline floor-log-expt
ceiling-log-expt))
Expand Down
6 changes: 4 additions & 2 deletions code/packages.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,5 +69,7 @@

(defpackage #:quaviver.condition
(:use #:common-lisp)
(:export #:float-overflow-error
#:float-underflow-error))
(:shadow #:floating-point-overflow
#:floating-point-underflow)
(:export #:floating-point-overflow
#:floating-point-underflow))
6 changes: 4 additions & 2 deletions code/schubfach/implementation.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,10 +27,10 @@
,(quaviver:float-internal-integer-form type value)
(declare (type (unsigned-byte ,word-size) significand)
(type (or keyword quaviver:exponent-word)
exponent k)
exponent)
(type fixnum sign))
(when (or (keywordp exponent)
(zerop exponent))
(zerop significand))
(return-from %schubfach
(values significand exponent sign)))
(let* ((lower-boundary-is-closer (= (logcount significand) 1))
Expand All @@ -40,6 +40,8 @@
(expt10 (quaviver.math:expt ,arithmetic-size 10 k)))
(declare (type boolean
lower-boundary-is-closer is-even)
(type quaviver:exponent-word
k)
(type (integer 0 4)
h)
(type (quaviver.math:arithmetic-word ,arithmetic-size 2)
Expand Down

0 comments on commit f9716a8

Please sign in to comment.