dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

base: Avoid 'call-with-current-continuation'.

Browse source 
'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'.
This commit is contained in:
Ludovic Courtès 2020-02-23 18:49:53 +01:00 • committed by Dale Mellor
commit 5794ea5a5b
1 changed files with 21 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

42
src/mcron/base.scm
View file

@ -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))))
(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))))))))
(for-each run-job next-jobs-lst)
(child-cleanup)
(loop)))))))