2008-02-18 17:20:18 -05:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
2008-02-18 10:08:59 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-11-30 19:28:15 -05:00
|
|
|
USING: deques threads kernel arrays sequences alarms fry ;
|
2008-02-18 10:08:59 -05:00
|
|
|
IN: concurrency.conditions
|
|
|
|
|
2008-08-19 15:06:20 -04:00
|
|
|
: notify-1 ( deque -- )
|
|
|
|
dup deque-empty? [ drop ] [ pop-back resume-now ] if ;
|
2008-02-18 10:08:59 -05:00
|
|
|
|
2008-08-19 15:06:20 -04:00
|
|
|
: notify-all ( deque -- )
|
|
|
|
[ resume-now ] slurp-deque ;
|
2008-02-22 00:47:06 -05:00
|
|
|
|
|
|
|
: queue-timeout ( queue timeout -- alarm )
|
|
|
|
#! Add an alarm which removes the current thread from the
|
|
|
|
#! queue, and resumes it, passing it a value of t.
|
2008-11-30 19:28:15 -05:00
|
|
|
[
|
|
|
|
[ self swap push-front* ] keep '[
|
|
|
|
_ _
|
|
|
|
[ delete-node ] [ drop node-value ] 2bi
|
|
|
|
t swap resume-with
|
|
|
|
]
|
|
|
|
] dip later ;
|
2008-02-18 10:08:59 -05:00
|
|
|
|
2009-04-05 00:04:53 -04:00
|
|
|
ERROR: wait-timeout ;
|
|
|
|
|
2008-02-19 15:38:02 -05:00
|
|
|
: wait ( queue timeout status -- )
|
2008-02-22 00:47:06 -05:00
|
|
|
over [
|
2008-11-30 19:28:15 -05:00
|
|
|
[ queue-timeout [ drop ] ] dip suspend
|
2009-04-05 00:04:53 -04:00
|
|
|
[ wait-timeout ] [ cancel-alarm ] if
|
2008-02-22 00:47:06 -05:00
|
|
|
] [
|
2008-11-30 19:28:15 -05:00
|
|
|
[ drop '[ _ push-front ] ] dip suspend drop
|
2008-02-22 00:47:06 -05:00
|
|
|
] if ;
|