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
							 |