/pliant/language/schedule/namedsem.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	module "/pliant/language/unsafe.pli"
17
18
19	type NamedSem
20	field Sem dict_lock
21	field Int locked_count <- 0
22	field Dictionary dict
23
24
25	method sem request name
26	arg_rw NamedSem sem ; arg Str name
27	atomic_add sem:locked_count 1
28	sem:dict_lock request
29	var Link:Sem s :> (sem:dict first name) map Sem
30	if not exists:s
31	s :> new Sem
32	sem:dict insert name true addressof:s
33	sem:dict_lock release
34	s request
35
36
37	method sem nowait_request name -> success
38	arg_rw NamedSem sem ; arg Str name ; arg CBool success
39	atomic_add sem:locked_count 1
40	sem:dict_lock request
41	var Link:Sem s :> (sem:dict first name) map Sem
42	if not exists:s
43	s :> new Sem
44	sem:dict insert name true addressof:s
45	sem:dict_lock release
46	success := s nowait_request
47	if not success
48	atomic_add sem:locked_count (-1)
49
50
51	method sem release name
52	arg_rw NamedSem sem ; arg Str name
53	sem:dict_lock request
54	var Link:Sem s :> (sem:dict first name) map Sem
55	check exists:s "Attempted to release a not previously requested named semaphore"
56	if sem:locked_count=1 and sem:dict:count>=16
57	sem dict := var Dictionary empty_dictionary
58	sem:dict_lock release
59	s release
60	atomic_add sem:locked_count (-1)
61
62
63
64	export NamedSem
65	export '. request' '. nowait_request' '. release'
66