1 (defun check-float-file (name)
2 (with-open-file (stream name
:if-does-not-exist nil
)
4 (format t
"; Checking ~S~%" (pathname stream
))
5 ;; Ensure that we're reading the correct variant of the file
6 ;; in case there is more than one set of floating-point formats.
7 (assert (eq (read stream
) :default
))
8 (sb-kernel::with-float-traps-masked
(:overflow
:divide-by-zero
)
9 (let ((*readtable
* (copy-readtable)))
10 ;; No need to do a full-blown read-time-eval.
11 (set-dispatch-macro-character
12 #\
# #\.
(lambda (stream subchar arg
)
13 (declare (ignore subchar arg
))
14 (let ((expr (read stream t nil t
)))
16 (s (sb-kernel:make-single-float
(second expr
)))
17 (d (sb-kernel:make-double-float
(second expr
) (third expr
)))))))
18 (dolist (expr (read stream
))
19 (destructuring-bind (fun args . result
) expr
20 (let ((actual (if (eql fun
'read-from-string
)
21 (let ((*read-default-float-format
* (car args
)))
22 (multiple-value-list (apply fun
(sb-int:ensure-list
(cdr args
)))))
23 (multiple-value-list (apply fun
(sb-int:ensure-list args
))))))
24 (labels ((eqal (x y
) ; non-ideal name, but other names are also non-ideal
26 (cons (and (consp y
) (eqal (car x
) (car y
)) (eqal (cdr x
) (cdr y
))))
30 (string (string= x y
)))))
31 (unless (eqal actual result
)
33 "FLOAT CACHE LINE ~S vs COMPUTED ~S~%"
34 expr actual
)))))))))))
36 (compile 'check-float-file
)
