/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 :> (sem:dict first name) map Sem 
 30    if not exists:s 
 31      :> new Sem 
 32      sem:dict insert name true addressof:s 
 33    sem:dict_lock release 
 34    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 :> (sem:dict first name) map Sem 
 42    if not exists:s 
 43      :> new Sem 
 44      sem:dict insert name true addressof:s 
 45    sem:dict_lock release 
 46    success := 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 :> (sem:dict first name) map Sem 
 55    check exists:"Attempted to release a not previously requested named semaphore" 
 56    if sem:locked_count=and sem:dict:count>=16 
 57      sem dict := var Dictionary empty_dictionary 
 58    sem:dict_lock release 
 59    release 
 60    atomic_add sem:locked_count (-1) 
 61   
 62   
 63   
 64  export NamedSem 
 65  export '. request' '. nowait_request' '. release' 
 66