suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* code reformatting

Browse Source 
* use kw.ss instead of opt-lambda
* moved a debugging comment into an `if'

svn: r4273
This commit is contained in:
Eli Barzilay 2006-09-07 19:55:41 +00:00
parent a0ccd557f5
commit a0c4d3b454
1 changed files with 163 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/mzlib/thread.ss
View File

@ -1,6 +1,6 @@
(module thread mzscheme
(require "etc.ss" "contract.ss")
(require "kw.ss" "contract.ss")
(provide run-server
consumer-thread)
@ -12,10 +12,7 @@
block.
|#
(define consumer-thread
(case-lambda
[(f) (consumer-thread f void)]
[(f init)
(define/kw (consumer-thread f #:optional [init void])
(unless (procedure? f) (raise-type-error 'consumer-thread "procedure" f))
(let ([sema (make-semaphore 0)]
[protect (make-semaphore 1)]
@ -56,12 +53,10 @@
(semaphore-wait protect)
(set! front-state (cons new-state front-state))
(semaphore-post protect)
(semaphore-post sema))))]))
(semaphore-post sema)))))
(define run-server
(opt-lambda (port-number
handler
connection-timeout
(define/kw (run-server port-number handler connection-timeout
#:optional
[handle-exn void]
[tcp-listen tcp-listen]
[tcp-close tcp-close]
@ -114,7 +109,7 @@
(sync/timeout connection-timeout t)
(custodian-shutdown-all c)))))))))
(loop))))
(lambda () (tcp-close l))))))
(lambda () (tcp-close l)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Couroutine
@ -127,44 +122,43 @@
;; coroutine : ((bool ->) -> X) -> X-coroutine-object
(define (coroutine f)
;;(printf "2. new coroutine~n")
(let* ((can-stop-lock (make-semaphore 1))
(done-ch (make-channel))
(ex-ch (make-channel))
(proceed-sema (make-semaphore))
(stop-enabled? #t)
(enable-stop
(let* ([can-stop-lock (make-semaphore 1)]
[done-ch (make-channel)]
[ex-ch (make-channel)]
[proceed-sema (make-semaphore)]
[stop-enabled? #t]
[enable-stop
(lambda (enable?)
;;(printf "3. enabling ~a~n" enable?)
(cond
((and enable? (not stop-enabled?))
[(and enable? (not stop-enabled?))
(semaphore-post can-stop-lock)
(set! stop-enabled? #t))
((and (not enable?) stop-enabled?)
(set! stop-enabled? #t)]
[(and (not enable?) stop-enabled?)
(semaphore-wait can-stop-lock)
(set! stop-enabled? #f)))
(set! stop-enabled? #f)])
;;(printf "3. finished enabling~n")
))
(tid (thread (lambda ()
)]
[tid (thread (lambda ()
(semaphore-wait proceed-sema)
;;(printf "3. creating coroutine thread~n")
(with-handlers (((lambda (exn) #t)
(with-handlers ([(lambda (exn) #t)
(lambda (exn)
(enable-stop #t)
(channel-put ex-ch exn))))
(channel-put ex-ch exn))])
(let ([v (f enable-stop)])
(enable-stop #t)
(channel-put done-ch v)))))))
(begin0
(make-coroutine-object tid can-stop-lock done-ch ex-ch #f)
(channel-put done-ch v)))))])
(begin0 (make-coroutine-object tid can-stop-lock done-ch ex-ch #f)
(thread-suspend tid)
(semaphore-post proceed-sema))))
;; coroutine : real-number X-coroutine-object -> bool
(define (coroutine-run timeout w)
(if (coroutine-object-worker w)
(let ([can-stop-lock (coroutine-object-can-stop-lock w)]
[worker (coroutine-object-worker w)])
#;(printf "2. starting coroutine~n")
(let ((can-stop-lock (coroutine-object-can-stop-lock w))
(worker (coroutine-object-worker w)))
(thread-resume worker)
(dynamic-wind
void
@ -218,4 +212,3 @@
(coroutine-run (real? coroutine? . -> . boolean?))
(coroutine-result (coroutine? . -> . any))
(coroutine-kill (coroutine? . -> . any))))