From 4c84fa31fb670d6e1814cf3c88d292bb1307e32d Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 14 Sep 2017 15:32:21 -0700 Subject: [PATCH] devops: Punt abort->top-level (which just spins), hook/^G-interrupt. --- src/devops/build.scm | 40 +++++++++++----------------------------- 1 file changed, 11 insertions(+), 29 deletions(-) diff --git a/src/devops/build.scm b/src/devops/build.scm index 05454270b..b28f7313f 100644 --- 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 -- 2.25.1