mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
ed3f1fdc57
Instead of canonicalizing the args automatically, use the normal XC-STRICT-CL machinery to ensure no one tries to e.g. COERCE to a host float. Also remove unused floating point format flag from xc float math file. It was never used, and if we did support multiple floating point formats for the host, this flag doesn't matter for that case any more since we use it only for cache and cross-check for a given build; it's no longer version-controlled as an oracle.
36 lines
1.9 KiB
Common Lisp
36 lines
1.9 KiB
Common Lisp
(defun check-float-file (name)
|
|
(with-open-file (stream name :if-does-not-exist nil)
|
|
(when stream
|
|
(format t "; Checking ~S~%" (pathname stream))
|
|
(sb-kernel::with-float-traps-masked (:overflow :divide-by-zero)
|
|
(let ((*readtable* (copy-readtable)))
|
|
;; No need to do a full-blown read-time-eval.
|
|
(set-dispatch-macro-character
|
|
#\# #\. (lambda (stream subchar arg)
|
|
(declare (ignore subchar arg))
|
|
(let ((expr (read stream t nil t)))
|
|
(ecase (car expr)
|
|
(make-single-float
|
|
(sb-kernel:make-single-float (second expr)))
|
|
(make-double-float
|
|
(sb-kernel:make-double-float (second expr) (third expr)))))))
|
|
(dolist (expr (read stream))
|
|
(destructuring-bind (fun args . result) expr
|
|
(let ((actual (if (eql fun 'read-from-string)
|
|
(let ((*read-default-float-format* (car args)))
|
|
(multiple-value-list (apply fun (sb-int:ensure-list (cdr args)))))
|
|
(multiple-value-list (apply fun (sb-int:ensure-list args))))))
|
|
(labels ((eqal (x y) ; non-ideal name, but other names are also non-ideal
|
|
(etypecase x
|
|
(cons (and (consp y) (eqal (car x) (car y)) (eqal (cdr x) (cdr y))))
|
|
(symbol (eql x y))
|
|
(rational (eql x y))
|
|
(float (eql x y))
|
|
(string (string= x y)))))
|
|
(unless (eqal actual result)
|
|
(cerror "Continue"
|
|
"FLOAT CACHE LINE ~S vs COMPUTED ~S~%"
|
|
expr actual)))))))))))
|
|
|
|
(compile 'check-float-file)
|