From 5794ea5a5b58344d375b3d099d51429040b9c1bb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 23 Feb 2020 18:49:53 +0100 Subject: base: Avoid 'call-with-current-continuation'. 'call-with-current-continuation' is overkill and not quite what we want. 'let/ec' is supported in Guile 2.0, 2.2, and 3.0. * src/mcron/base.scm (run-job-loop): Use 'let/ec' instead of 'call-with-current-continuation'. --- src/mcron/base.scm | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) (limited to 'src/mcron') diff --git a/src/mcron/base.scm b/src/mcron/base.scm index 572d45b..edcf1bc 100644 --- a/src/mcron/base.scm +++ b/src/mcron/base.scm @@ -27,6 +27,7 @@ (define-module (mcron base) #:use-module (ice-9 match) + #:use-module (ice-9 control) #:use-module (mcron environment) #:use-module (mcron utils) #:use-module (srfi srfi-1) @@ -224,25 +225,24 @@ next value." '(() () ()) (apply throw args))))))) - (call-with-current-continuation - (lambda (break) - (let loop () - (match (find-next-jobs #:schedule schedule) - ((next-time . next-jobs-lst) - (let ((sleep-time (if next-time - (- next-time (current-time)) - 2000000000))) - (when (> sleep-time 0) - (match (select* fd-list '() '() sleep-time) - ((() () ()) - ;; 'select' returned an empty set, perhaps because it got - ;; EINTR or EAGAIN. It's a good time to wait for child - ;; processes. - (child-cleanup)) - (((lst ...) () ()) - ;; There's some activity so leave the loop. - (break)))) - - (for-each run-job next-jobs-lst) - (child-cleanup) - (loop)))))))) + (let/ec break + (let loop () + (match (find-next-jobs #:schedule schedule) + ((next-time . next-jobs-lst) + (let ((sleep-time (if next-time + (- next-time (current-time)) + 2000000000))) + (when (> sleep-time 0) + (match (select* fd-list '() '() sleep-time) + ((() () ()) + ;; 'select' returned an empty set, perhaps because it got + ;; EINTR or EAGAIN. It's a good time to wait for child + ;; processes. + (child-cleanup)) + (((lst ...) () ()) + ;; There's some activity so leave the loop. + (break)))) + + (for-each run-job next-jobs-lst) + (child-cleanup) + (loop))))))) -- cgit v1.2.3