devops: Punt abort->top-level (which just spins), hook/^G-interrupt.

diff --git a/src/devops/build.scm b/src/devops/build.scm
index 05454270b40633119a58325b1481bf662483a4c6..b28f7313fcce1fed0dd765d5a8781d4222061af1 100644 (file)
--- a/src/devops/build.scm
+++ b/src/devops/build.scm
@@ -214,40 +214,22 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
      (lambda ()
        (call-with-current-continuation
        (lambda (abort-batch-job)
-         (log-timestamp)
-         (flush-output)
-         (with-restart
-             'ABORT "Abort the Scheme batch job."
-             (lambda (message) 
+         (bind-condition-handler '()
+             (named-lambda (batch-condition-handler condition)
+               (fresh-line)
                (log-timestamp)
-               (log "Abort! "message"\n")
+               (write-condition-report condition (current-output-port))
+               (newline)
+               (flush-output)
                (abort-batch-job 7))
-             #f
            (lambda ()
+             (log-timestamp)
+             (flush-output)
              (log "Batch job started.\n")
              (flush-output)
-             (bind-condition-handler '()
-                 (named-lambda (batch-condition-handler condition)
-                   (fresh-line)
-                   (log-timestamp)
-                   (write-condition-report condition (current-output-port))
-                   (newline)
-                   (flush-output)
-                   (abort->top-level "Error in Scheme batch job."))
-               (lambda ()
-                 (environment-assign!
-                  (->environment '(runtime interrupt-handler))
-                  'hook/^G-interrupt
-                  (named-lambda (batch-^G-interrupt)
-                    (fresh-line)
-                    (log-timestamp)
-                    (log "Interrupt!\n")
-                    (flush-output)
-                    (abort->top-level "Scheme batch job interrupted.")))
-                 (thunk)
-                 (log "Batch job succeeded.\n")
-                 (flush-output)
-                 0))))))))))
+             (thunk)
+             (log "Batch job succeeded.\n")
+             0))))))))
 
 (define (with-output-log filename thunk)
   (let ((value