common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-09 23:16:41 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Make ./build-all-cores.sh check float files.

Browse source 
Check the xfloat-math.lisp-expr files produced in each tree directly,
and dispense with the almost-but-not-quite stand-alone merging utility
which required loading the whole cross-compiler just to check some
lisp expressions matched what they're supposed to be on the host,
which is overkill.
This commit is contained in:
Charles Zhang 2024-04-21 00:48:52 +02:00
parent c2b5f3eb2d
commit 61370e23f3
5 changed files with 48 additions and 85 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
build-all-cores.sh
View file

@ -132,7 +132,9 @@ obj/xbuild/{cfg}.core: obj/xbuild/{cfg}/xc.core
:search t))
(when (= (process-exit-code *process*) 0)
(load "src/cold/shared" :verbose t)
;; TODO: merge the xfloat-math files, unless we decide to get rid of them
(load "validate-float.lisp")
(dolist (pathname (directory "obj/xbuild/**/xfloat-math.lisp-expr"))
(check-float-file pathname))
(dolist (nbits '(30 61 63))
(let* ((filename (format nil "xperfecthash~D.lisp-expr" nbits))
(sources (directory (format nil "obj/xbuild/*/from-xc/~A" filename))))

4
make-target-2.sh
View file

@ -74,7 +74,9 @@ echo //doing warm init - load and dump phase
EOF
./src/runtime/sbcl --noinform --core output/sbcl.core \
--no-sysinit --no-userinit --noprint <<EOF
--no-sysinit --no-userinit --noprint <<EOF
(load "validate-float.lisp")
(check-float-file "output/xfloat-math.lisp-expr")
(ignore-errors (delete-file "output/reorg.core"))
;; * Lisp won't read compressed cores, and crashes on arm64
#+(and mark-region-gc x86-64 (not sb-core-compression))

43
src/code/cross-float.lisp
View file

@ -175,8 +175,7 @@
authoritative-answer))))))
(setf (gethash key table) (if (singleton-p values) (car values) (cons '&values values))))
(defun parse-xfloat-math-file (stream table mode)
(declare (type (member :all :merge) mode))
(defun parse-xfloat-math-file (stream table)
;; Ensure that we're reading the correct variant of the file
;; in case there is more than one set of floating-point formats.
(assert (eq (read stream) :default))
@ -201,18 +200,7 @@
(rest values)
values)))
(when existsp
(case mode
(:merge
(when (and existsp
(not (equal
(if (and (listp existsp) (eq (car existsp) '&values))
(cdr existsp)
existsp)
(if (singleton-p values) (car values) values))))
(error "Got different answers for ~S: ~S and ~S"
key existsp values)))
(:all ; should not happen
(error "Line ~D of float cache: ~S is repeated" line key))))
(error "Line ~D of float cache: ~S is repeated" line key))
(float-ops-cache-insert table key values))))
(delete-package pkg))))
@ -225,7 +213,7 @@
(with-open-file (stream (setq pathname (sb-cold::math-journal-pathname :input))
:if-does-not-exist nil)
(when stream
(parse-xfloat-math-file stream table :all)
(parse-xfloat-math-file stream table)
(setf (cdr cache) (hash-table-count table))
(when cl:*compile-verbose*
(format t "~&; Math journal: prefilled ~D entries from ~S~%"
@ -1029,31 +1017,6 @@
(if (consp result) result (list result)))))))
(format stream ")~%"))
;;; Recipe:
;;; $ ./build-all-cores.sh
;;; $ /path/to/host/sbcl
;;; * (load "load-xc")
;;; * (sb-impl:merge-all-xfloat-files)
;;; Check:
;;; $ ./make-target-2.sh
(export 'merge-all-xfloat-files)
(defun merge-all-xfloat-files ()
(let ((ht sb-cold::*math-ops-memoization*)
(total-delta 0))
(dolist (pathname (directory "obj/xbuild/**/xfloat-math.lisp-expr"))
(let ((old-count (hash-table-count ht)))
(with-open-file (stream pathname)
(parse-xfloat-math-file stream ht :merge)
(let ((delta (- (hash-table-count ht) old-count)))
(incf total-delta delta)
(when (plusp delta)
(format t "~D new entr~@:P from ~S~%" delta pathname))))))
(if (zerop total-delta)
(format t "~&Nothing new~%")
(with-open-file (stream "output/xfloat-math.lisp-expr"
:direction :output :if-exists :supersede)
(dump-math-memoization-table ht stream)))))
(defun show-interned-numbers (stream)
(flet ((to-native (x)
(declare (ignorable x))

43
src/cold/warm.lisp
View file

@ -85,49 +85,6 @@ sb-kernel::
;;; Verify that compile-time floating-point math matches load-time.
(defvar *compile-files-p*)
(when (or (not (boundp '*compile-files-p*)) *compile-files-p*)
(with-open-file (stream "output/xfloat-math.lisp-expr" :if-does-not-exist nil)
(when stream
(format t "; Checking ~S~%" (pathname stream))
;; Ensure that we're reading the correct variant of the file
;; in case there is more than one set of floating-point formats.
(assert (eq (read stream) :default))
(sb-kernel::with-float-traps-masked (:overflow :divide-by-zero)
(let ((*readtable* (copy-readtable))
(*package* (find-package "SB-KERNEL")))
;; The reasoning behind this limited-use variant of read-time-eval is that
;; since it is too early to actually use EVAL in the interpreted fashion,
;; EVAL would call COMPILE which is just ridiculous because it would mean
;; compiling however many #. expression there are in this file
(set-dispatch-macro-character
#\# #\. (lambda (stream subchar arg)
(declare (ignore subchar arg))
(let ((expr (read stream t nil t)))
(ecase (car expr)
(sb-kernel::s (sb-kernel:make-single-float (second expr)))
(sb-kernel::d
(sb-kernel:make-double-float (second expr) (third expr)))))))
(dolist (expr (read stream))
(destructuring-bind (fun args . result) expr
(let ((result (if (eq (first result) 'sb-kernel::&values)
(rest result)
result))
(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)))))))))))
(when (if (boundp '*compile-files-p*) *compile-files-p* t)
(with-open-file (output "output/cold-vop-usage.txt" :if-does-not-exist nil)
(when output

39
validate-float.lisp Normal file
View file

@ -0,0 +1,39 @@
(defun check-float-file (name)
(with-open-file (stream name :if-does-not-exist nil)
(when stream
(format t "; Checking ~S~%" (pathname stream))
;; Ensure that we're reading the correct variant of the file
;; in case there is more than one set of floating-point formats.
(assert (eq (read stream) :default))
(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)
(s (sb-kernel:make-single-float (second expr)))
(d (sb-kernel:make-double-float (second expr) (third expr)))))))
(dolist (expr (read stream))
(destructuring-bind (fun args . result) expr
(let ((result (if (eq (first result) 'sb-kernel::&values)
(rest result)
result))
(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)