| 
									
										
										
										
											2010-03-27 12:03:06 -04:00
										 |  |  | ! Copyright (C) 2008, 2010 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2010-06-10 17:39:13 -04:00
										 |  |  | USING: deques threads kernel arrays sequences timers fry ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | IN: concurrency.conditions | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-19 15:06:20 -04:00
										 |  |  | : notify-1 ( deque -- )
 | 
					
						
							| 
									
										
										
										
											2010-04-01 20:05:32 -04:00
										 |  |  |     dup deque-empty? [ drop ] [ pop-back resume-now ] if ; inline
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-08-19 15:06:20 -04:00
										 |  |  | : notify-all ( deque -- )
 | 
					
						
							| 
									
										
										
										
											2010-04-01 20:05:32 -04:00
										 |  |  |     [ resume-now ] slurp-deque ; inline
 | 
					
						
							| 
									
										
										
										
											2008-02-22 00:47:06 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-06-10 17:39:13 -04:00
										 |  |  | : queue-timeout ( queue timeout -- timer )
 | 
					
						
							|  |  |  |     #! Add an timer which removes the current thread from the | 
					
						
							| 
									
										
										
										
											2008-02-22 00:47:06 -05:00
										 |  |  |     #! 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 ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-27 12:03:06 -04:00
										 |  |  | : queue ( queue -- )
 | 
					
						
							| 
									
										
										
										
											2010-04-01 20:05:32 -04:00
										 |  |  |     [ self ] dip push-front ; inline
 | 
					
						
							| 
									
										
										
										
											2010-03-27 12:03:06 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 |  |  | : wait ( queue timeout status -- )
 | 
					
						
							| 
									
										
										
										
											2008-02-22 00:47:06 -05:00
										 |  |  |     over [ | 
					
						
							| 
									
										
										
										
											2010-03-27 12:03:06 -04:00
										 |  |  |         [ queue-timeout ] dip suspend | 
					
						
							| 
									
										
										
										
											2010-06-10 17:39:13 -04:00
										 |  |  |         [ wait-timeout ] [ stop-timer ] if
 | 
					
						
							| 
									
										
										
										
											2008-02-22 00:47:06 -05:00
										 |  |  |     ] [ | 
					
						
							| 
									
										
										
										
											2010-03-27 12:03:06 -04:00
										 |  |  |         [ drop queue ] dip suspend drop
 | 
					
						
							| 
									
										
										
										
											2010-04-01 20:05:32 -04:00
										 |  |  |     ] if ; inline
 |