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) (define-module (mcron base)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 control)
#:use-module (mcron environment) #:use-module (mcron environment)
#:use-module (mcron utils) #:use-module (mcron utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -224,25 +225,24 @@ next value."
'(() () ()) '(() () ())
(apply throw args))))))) (apply throw args)))))))
(call-with-current-continuation (let/ec break
(lambda (break) (let loop ()
(let loop () (match (find-next-jobs #:schedule schedule)
(match (find-next-jobs #:schedule schedule) ((next-time . next-jobs-lst)
((next-time . next-jobs-lst) (let ((sleep-time (if next-time
(let ((sleep-time (if next-time (- next-time (current-time))
(- next-time (current-time)) 2000000000)))
2000000000))) (when (> sleep-time 0)
(when (> sleep-time 0) (match (select* fd-list '() '() sleep-time)
(match (select* fd-list '() '() sleep-time) ((() () ())
((() () ()) ;; 'select' returned an empty set, perhaps because it got
;; 'select' returned an empty set, perhaps because it got ;; EINTR or EAGAIN. It's a good time to wait for child
;; EINTR or EAGAIN. It's a good time to wait for child ;; processes.
;; processes. (child-cleanup))
(child-cleanup)) (((lst ...) () ())
(((lst ...) () ()) ;; There's some activity so leave the loop.
;; There's some activity so leave the loop. (break))))
(break))))
(for-each run-job next-jobs-lst) (for-each run-job next-jobs-lst)
(child-cleanup) (child-cleanup)
(loop)))))))) (loop)))))))