summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2014-02-17 14:13:25 -0500
committerDavid Thompson <dthompson2@worcester.edu>2014-02-17 14:13:25 -0500
commit77007e55bdf10e498912701f590f33d49efa4c09 (patch)
tree3ebb4292740759ce65ccfdafe0bdf7d4d66d4b1f /2d
parent38f9696fed2b55e6f5484433298b7c34141da243 (diff)
Revert "Make agendas thread-safe."
This reverts commit 38f9696fed2b55e6f5484433298b7c34141da243.
Diffstat (limited to '2d')
-rw-r--r--2d/agenda.scm69
1 files changed, 32 insertions, 37 deletions
diff --git a/2d/agenda.scm b/2d/agenda.scm
index 5154f06..2b28a54 100644
--- a/2d/agenda.scm
+++ b/2d/agenda.scm
@@ -23,7 +23,6 @@
(define-module (2d agenda)
#:use-module (ice-9 q)
- #:use-module (ice-9 threads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
@@ -68,15 +67,14 @@ list CALLBACKS."
;;;
(define-record-type <agenda>
- (%make-agenda time mutex segments)
+ (%make-agenda time segments)
agenda?
(time agenda-time set-agenda-time!)
- (mutex agenda-mutex)
(segments agenda-segments set-agenda-segments!))
(define (make-agenda)
"Create a new, empty agenda."
- (%make-agenda 0 (make-mutex 'recursive) '()))
+ (%make-agenda 0 '()))
(define (agenda-empty? agenda)
"Return #t if AGENDA has no scheduled procedures."
@@ -121,46 +119,43 @@ and enqueue CALLBACK."
(define (tick-agenda! agenda)
"Move AGENDA forward in time and run scheduled procedures."
- (with-mutex (agenda-mutex agenda)
- (set-agenda-time! agenda (1+ (agenda-time agenda)))
- (let next-segment ()
- (unless (agenda-empty? agenda)
- (let ((segment (first-segment agenda)))
- ;; Process time segment if it is scheduled before or at the
- ;; current agenda time.
- (when (>= (agenda-time agenda) (segment-time segment))
- (flush-queue! (segment-queue segment))
- (set-agenda-segments! agenda (rest-segments agenda))
- (next-segment)))))))
+ (set-agenda-time! agenda (1+ (agenda-time agenda)))
+ (let next-segment ()
+ (unless (agenda-empty? agenda)
+ (let ((segment (first-segment agenda)))
+ ;; Process time segment if it is scheduled before or at the
+ ;; current agenda time.
+ (when (>= (agenda-time agenda) (segment-time segment))
+ (flush-queue! (segment-queue segment))
+ (set-agenda-segments! agenda (rest-segments agenda))
+ (next-segment))))))
(define (clear-agenda! agenda)
"Remove all scheduled procedures from AGENDA."
- (with-mutex (agenda-mutex agenda)
- (set-agenda-segments! agenda '())))
+ (set-agenda-segments! agenda '()))
(define* (schedule agenda thunk #:optional (delay 1))
"Schedule the procedure THUNK in AGENDA to be run DELAY ticks from
now. DELAY defaults to 1 if not specified."
- (with-mutex (agenda-mutex agenda)
- (let ((time (agenda-time-delay agenda delay)))
- (define (belongs-before? segments)
- (or (null? segments)
- (< time (segment-time (car segments)))))
-
- (define (add-to-segments segments)
- ;; Add to existing time segment if the times match
- (if (= (segment-time (car segments)) time)
- (segment-enq (car segments) thunk)
- ;; Continue searching
- (if (belongs-before? (cdr segments))
- ;; Create new time segment and insert it where it belongs
- (insert-segment segments time thunk)
- ;; Continue searching
- (add-to-segments (cdr segments)))))
-
- (if (belongs-before? (agenda-segments agenda))
- (agenda-add-segment agenda time thunk)
- (add-to-segments (agenda-segments agenda))))))
+ (let ((time (agenda-time-delay agenda delay)))
+ (define (belongs-before? segments)
+ (or (null? segments)
+ (< time (segment-time (car segments)))))
+
+ (define (add-to-segments segments)
+ ;; Add to existing time segment if the times match
+ (if (= (segment-time (car segments)) time)
+ (segment-enq (car segments) thunk)
+ ;; Continue searching
+ (if (belongs-before? (cdr segments))
+ ;; Create new time segment and insert it where it belongs
+ (insert-segment segments time thunk)
+ ;; Continue searching
+ (add-to-segments (cdr segments)))))
+
+ (if (belongs-before? (agenda-segments agenda))
+ (agenda-add-segment agenda time thunk)
+ (add-to-segments (agenda-segments agenda)))))
(define (schedule-interval agenda thunk delay)
"Schedule THUNK within AGENDA to be applied every DELAY ticks."