projects
/
8sync.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
DRAFT doc: Update `NEWS'.
[8sync.git]
/
8sync
/
agenda.scm
diff --git
a/8sync/agenda.scm
b/8sync/agenda.scm
index 3aa43da1eeec85dee0f6d9f9d58abe1d6084b558..7a76ebf5837359951d964726380aac86fe1c3df7 100644
(file)
--- a/
8sync/agenda.scm
+++ b/
8sync/agenda.scm
@@
-1,5
+1,5
@@
;;; 8sync --- Asynchronous programming for Guile
;;; 8sync --- Asynchronous programming for Guile
-;;; Copyright
(C) 2015, 2016
Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright
© 2015, 2016, 2017
Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of 8sync.
;;;
;;;
;;; This file is part of 8sync.
;;;
@@
-62,7
+62,7
@@
stop-on-nothing-to-do
%current-agenda-prompt
stop-on-nothing-to-do
%current-agenda-prompt
-
start
-agenda agenda-run-once!))
+
run
-agenda agenda-run-once!))
\f
;;; Agenda definition
\f
;;; Agenda definition
@@
-411,7
+411,8
@@
forge ahead in our current function!"
;; convert into sec / usec pair
(receive (secs usecs)
(floor/ next-time-in-usecs 1000000)
;; convert into sec / usec pair
(receive (secs usecs)
(floor/ next-time-in-usecs 1000000)
- (cons secs (floor usecs))))
+ (cons (inexact->exact secs)
+ (inexact->exact (floor usecs)))))
(define (convert-integer)
(cons (+ in-secs cur-secs) cur-usecs))
(if (integer? in-secs)
(define (convert-integer)
(cons (+ in-secs cur-secs) cur-usecs))
(if (integer? in-secs)
@@
-466,13
+467,19
@@
Also handles sleeping when all we have to do is wait on the schedule."
;; TODO: support usecond wait time too
(match (get-wait-time)
((sec . usec)
;; TODO: support usecond wait time too
(match (get-wait-time)
((sec . usec)
- (catch
'
system-error
+ (catch
#t ; expect: wrong-type-arg (open port),
system-error
(lambda ()
(select (hash-keys (agenda-read-port-map agenda))
(hash-keys (agenda-write-port-map agenda))
'()
sec usec))
(lambda (key . rest-args)
(lambda ()
(select (hash-keys (agenda-read-port-map agenda))
(hash-keys (agenda-write-port-map agenda))
'()
sec usec))
(lambda (key . rest-args)
+ (unless (and (memq key '(system-error wrong-type-arg))
+ (match rest-args
+ (((or "select" "get-u8" "get-bytevector-n" "lookahead-u8"
+ "put-u8" "put-bytevector") arg ...) #t)
+ (_ #f)))
+ (apply throw key rest-args))
(match rest-args
((_ _ _ (EINTR))
'(() () ()))
(match rest-args
((_ _ _ (EINTR))
'(() () ()))
@@
-553,16
+560,14
@@
on suspendable ports."
(= 0 (hash-count (const #t) (agenda-write-port-map agenda)))))
(= 0 (hash-count (const #t) (agenda-write-port-map agenda)))))
-(define* (
start
-agenda agenda
-
#:key (stop-condition stop-on-nothing-to-do)
-
;; For live hacking madness, etc
-
(post-run-hook #f))
+(define* (
run
-agenda agenda
+ #:key (stop-condition stop-on-nothing-to-do)
+ ;; For live hacking madness, etc
+ (post-run-hook #f))
;; TODO: Document fields
"Start up the AGENDA"
(install-suspendable-ports!)
(parameterize ((%current-agenda-prompt (agenda-prompt-tag agenda))
;; TODO: Document fields
"Start up the AGENDA"
(install-suspendable-ports!)
(parameterize ((%current-agenda-prompt (agenda-prompt-tag agenda))
- ;; @@: Couldn't we just parameterize this at the start of
- ;; the agenda...?
(current-read-waiter wait-for-readable)
(current-write-waiter wait-for-writable))
(while (not (stop-condition agenda))
(current-read-waiter wait-for-readable)
(current-write-waiter wait-for-writable))
(while (not (stop-condition agenda))