| 
									
										
										
										
											2008-02-25 20:37:43 -05:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-05-07 04:28:45 -04:00
										 |  |  | USING: dlists kernel threads concurrency.conditions accessors ;
 | 
					
						
							| 
									
										
										
										
											2008-02-25 20:37:43 -05:00
										 |  |  | IN: concurrency.flags | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-05-07 04:28:45 -04:00
										 |  |  | TUPLE: flag value threads ;
 | 
					
						
							| 
									
										
										
										
											2008-02-25 20:37:43 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-05-07 04:28:45 -04:00
										 |  |  | : <flag> ( -- flag ) f <dlist> flag boa ;
 | 
					
						
							| 
									
										
										
										
											2008-02-25 20:37:43 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : raise-flag ( flag -- )
 | 
					
						
							| 
									
										
										
										
											2008-05-07 04:28:45 -04:00
										 |  |  |     dup value>> [ drop ] [ t >>value threads>> notify-all ] if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : wait-for-flag-timeout ( flag timeout -- )
 | 
					
						
							| 
									
										
										
										
											2008-11-30 19:28:15 -05:00
										 |  |  |     over value>> [ 2drop ] [ [ threads>> ] dip "flag" wait ] if ;
 | 
					
						
							| 
									
										
										
										
											2008-02-25 20:37:43 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-27 18:15:52 -05:00
										 |  |  | : wait-for-flag ( flag -- )
 | 
					
						
							| 
									
										
										
										
											2008-05-07 04:28:45 -04:00
										 |  |  |     f wait-for-flag-timeout ;
 | 
					
						
							| 
									
										
										
										
											2008-02-27 18:15:52 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-25 20:37:43 -05:00
										 |  |  | : lower-flag ( flag -- )
 | 
					
						
							| 
									
										
										
										
											2008-05-07 04:28:45 -04:00
										 |  |  |     [ wait-for-flag ] [ f >>value drop ] bi ;
 |