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")
14 ;;; exiting with 0 probably means that it's a good build.
15 (defun mt2-hammer (n-iterations)
17 (dotimes (i n-iterations
)
18 (let ((dir (format nil
"obj/attempt~D/" (1+ i
))))
19 (ensure-directories-exist dir
)
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
33 (setq jobs
(nreverse jobs
))
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
)
40 (unless (= (process-exit-code job
) 0)
41 (format t
"~&~S did not exit with 0~%"