34 lines
		
	
	
		
			1.0 KiB
		
	
	
	
		
			Factor
		
	
	
		
			Executable File
		
	
			
		
		
	
	
			34 lines
		
	
	
		
			1.0 KiB
		
	
	
	
		
			Factor
		
	
	
		
			Executable File
		
	
| ! Copyright (C) 2008 Slava Pestov.
 | |
| ! See http://factorcode.org/license.txt for BSD license.
 | |
| USING: dlists kernel threads math concurrency.conditions
 | |
| continuations ;
 | |
| IN: concurrency.semaphores
 | |
| 
 | |
| TUPLE: semaphore count threads ;
 | |
| 
 | |
| : <semaphore> ( n -- semaphore )
 | |
|     dup 0 < [ "Cannot have semaphore with negative count" throw ] when
 | |
|     <dlist> semaphore boa ;
 | |
| 
 | |
| : wait-to-acquire ( semaphore timeout -- )
 | |
|     >r semaphore-threads r> "semaphore" wait ;
 | |
| 
 | |
| : acquire-timeout ( semaphore timeout -- )
 | |
|     over semaphore-count zero?
 | |
|     [ dupd wait-to-acquire ] [ drop ] if
 | |
|     dup semaphore-count 1- swap set-semaphore-count ;
 | |
| 
 | |
| : acquire ( semaphore -- )
 | |
|     f acquire-timeout ;
 | |
| 
 | |
| : release ( semaphore -- )
 | |
|     dup semaphore-count 1+ over set-semaphore-count
 | |
|     semaphore-threads notify-1 ;
 | |
| 
 | |
| : with-semaphore-timeout ( semaphore timeout quot -- )
 | |
|     pick rot acquire-timeout swap
 | |
|     [ release ] curry [ ] cleanup ; inline
 | |
| 
 | |
| : with-semaphore ( semaphore quot -- )
 | |
|     over acquire swap [ release ] curry [ ] cleanup ; inline
 |