Trust non-returning functions during sb-xc.
[sbcl.git] / maketarg2loop.lisp
blobcb6d0f94600221c2e1969fc8aab407d62367142d
2 ;;; Run this in the host lisp. It will invoke the compilation pass
3 ;;; of make-target-2 a specified number of times.
4 ;;; This is probably not super useful for actually debugging a
5 ;;; failed build, but it is useful to identify the revision that
6 ;;; introduced a GC regression that causes random invariant failures.
7 ;;; If you have an estimate of how often builds fail at head or WIP,
8 ;;; you could bisect using (MT2-HAMMER N) for sufficiently large N to
9 ;;; decide whether each bisection step passes or fails. e.g.
10 ;;; if your intuition tells you that you were seeing at least 1 in 20
11 ;;; build failures at the latest revision, then:
12 ;;; * (load "maketarget2loop.lisp")
13 ;;; * (mt2-hammer 20)
14 ;;; exiting with 0 probably means that it's a good build.
15 (defun mt2-hammer (n-iterations)
16 (let (jobs)
17 (dotimes (i n-iterations)
18 (let ((dir (format nil "obj/attempt~D/" (1+ i))))
19 (ensure-directories-exist dir)
20 (let ((job
21 (sb-ext:run-program
22 "src/runtime/sbcl"
23 `("--core" "output/cold-sbcl.core"
24 "--lose-on-corruption" "--no-sysinit" "--no-userinit"
25 "--eval" ,(format nil "(defvar *objfile-prefix* ~S)" dir)
26 "--load" "src/cold/warm.lisp")
27 :output (format nil "~A/out" dir)
28 :if-output-exists :supersede
29 :error (format nil "~A/err" dir)
30 :if-error-exists :supersede
31 :wait nil)))
32 (push job jobs))))
33 (setq jobs (nreverse jobs))
34 (loop
35 (let ((n-running (count :running jobs :key #'process-status)))
36 (when (zerop n-running) (return))
37 (format t "~&Waiting for ~D job~:P~%" n-running)
38 (sleep 2)))
39 (dolist (job jobs)
40 (unless (= (process-exit-code job) 0)
41 (format t "~&~S did not exit with 0~%"
42 job)))))