Add a thing to help bisect over GC flakes

since make-target-2 is the first opportunity for the newly-built SBCL
to flake, use that as the actual test.

maketarg2loop.lisp

@@ -0,0 +1,42 @@
+
+;;; Run this in the host lisp. It will invoke the compilation pass
+;;; of make-target-2 a specified number of times.
+;;; This is probably not super useful for actually debugging a
+;;; failed build, but it is useful to identify the revision that
+;;; introduced a GC regression that causes random invariant failures.
+;;; If you have an estimate of how often builds fail at head or WIP,
+;;; you could bisect using (MT2-HAMMER N) for sufficiently large N to
+;;; decide whether each bisection step passes or fails. e.g.
+;;; if your intuition tells you that you were seeing at least 1 in 20
+;;; build failures at the latest revision, then:
+;;; * (load "maketarget2loop.lisp")
+;;; * (mt2-hammer 20)
+;;; exiting with 0 probably means that it's a good build.
+(defun mt2-hammer (n-iterations)
+  (let (jobs)
+    (dotimes (i n-iterations)
+      (let ((dir (format nil "obj/attempt~D/" (1+ i))))
+        (ensure-directories-exist dir)
+        (let ((job
+               (sb-ext:run-program
+                "src/runtime/sbcl"
+                `("--core" "output/cold-sbcl.core"
+                           "--lose-on-corruption" "--no-sysinit" "--no-userinit"
+                           "--eval" ,(format nil "(defvar *objfile-prefix* ~S)" dir)
+                           "--load" "src/cold/warm.lisp")
+                :output (format nil "~A/out" dir)
+                :if-output-exists :supersede
+                :error (format nil "~A/err" dir)
+                :if-error-exists :supersede
+                :wait nil)))
+          (push job jobs))))
+    (setq jobs (nreverse jobs))
+    (loop
+     (let ((n-running (count :running jobs :key #'process-status)))
+       (when (zerop n-running) (return))
+       (format t "~&Waiting for ~D job~:P~%" n-running)
+       (sleep 2)))
+    (dolist (job jobs)
+      (unless (= (process-exit-code job) 0)
+        (format t "~&~S did not exit with 0~%"
+                job)))))

src/cold/warm.lisp

@@ -254,7 +254,7 @@ sb-kernel::(rplaca (last *handler-clusters*) (car **initial-handler-clusters**))
 
 (sb-c::dump/restore-interesting-types 'write)
 (when (hash-table-p sb-c::*static-vop-usage-counts*)
-  (with-open-file (output "output/warm-vop-usage.txt"
+  (with-open-file (output (merge-pathnames "warm-vop-usage.txt" *objfile-prefix*)
                           :direction :output :if-exists :supersede)
     (let (list)
       (sb-int:dohash ((name vop) sb-c::*backend-parsed-vops*)

tests/parallel-exec.sh

@@ -235,7 +235,7 @@ TEST_DIRECTORY=$junkdir SBCL_HOME=../obj/sbcl-home exec ../src/runtime/sbcl \
                                             :if-exists :supersede)
               (dolist (cell (sort list #'> :key #'car))
                 (format output "~7d ~s~%" (car cell) (cdr cell)))))
-          (sum-vop-usage "../output/warm-vop-usage.txt" nil)))
+          (sum-vop-usage "../obj/from-self/warm-vop-usage.txt" nil)))
 
       (format t "~&Total realtime: ~d msec~%" (elapsed-time-from start-time))
       (when missing-usage