------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 199x by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

abstract class $RW_LOCK is
   reader:$READER_LOCK;
   writer:$WRITER_LOCK;
end;

abstract class $READER_LOCK < $LOCK is end;
abstract class $WRITER_LOCK < $MUTEX is end;

-- Helper class for read/writer locks. Should not be used
-- outside of the library
abstract class $RW_WRITER < $WRITER_LOCK is
   r_acquirable(tid:THREAD_ID):BOOL;
   r_acquire(tid:THREAD_ID);
   r_release(tid:THREAD_ID);
   r_request(tid:THREAD_ID);
   r_cancel_request(tid:THREAD_ID);
   r_wait_for(tid:THREAD_ID):ARRAY{THREAD_ID};
end; 

-- Helper class for all reader/writer locks. should not be used
-- outside of this library.
class RW_READER < $READER_LOCK is
   include LOCK_INCLUDE;
   private attr w:$RW_WRITER;

   primary:$RW_WRITER is return w; end;

   create(wr:$RW_WRITER):SAME is
      r::=new;
      r.w:=wr;
      return r;
   end;
   acquirable(tid:THREAD_ID):BOOL is
      return w.r_acquirable(tid);
   end;

   acquire(tid:THREAD_ID) is
      w.r_acquire(tid);
   end;

   release(tid:THREAD_ID) is
      w.r_release(tid);
   end;

   request(tid:THREAD_ID) is
      w.r_request(tid);
   end;

   cancel_request(tid:THREAD_ID) is
      w.r_cancel_request(tid);
   end;

   wait_for(tid:THREAD_ID):ARRAY{THREAD_ID} is
      return w.r_wait_for(tid);
   end;
end;

-- implements a fair reader writer locks. It guarantees that
-- all reader/writer will eventually be able to lock it.

-- Helper class for fair reader/writer locks. should not be used
-- outside of this library.
class FRW_WRITER < $RW_WRITER is
   include LOCK_INCLUDE;
   private attr writer_id:THREAD_ID;
   private attr last_reader_id:THREAD_ID;
   private attr write_locks:INT;
   private attr read_locks:INT;
   private attr readers_in_lock:BAG{THREAD_ID};

   create:SAME is
      r::=new;
      r.init;
      return r;
   end;

   init is
      writer_id:=THREAD_ID::nil;
      write_locks:=0;
      read_locks:=0;
      readers_in_lock:=#;
   end;

   acquirable(tid:THREAD_ID):BOOL is
      return (read_locks=0 and write_locks=0) or writer_id=tid;
   end;

   r_acquirable(tid:THREAD_ID):BOOL is
      return write_locks=0 or writer_id=tid;
   end;

   acquire(tid:THREAD_ID) 
   pre (read_locks>0 and write_locks>0 and writer_id=tid)
       or ((read_locks=0 or last_reader_id=tid) and (write_locks=0 or writer_id=tid))
   is
      write_locks:=write_locks+1;
      writer_id:=tid;
   end;

   r_acquire(tid:THREAD_ID) 
   pre write_locks=0 or writer_id=tid
   is
      last_reader_id:=tid;
      read_locks:=read_locks+1;
      readers_in_lock.add(tid);
   end;

   release(tid:THREAD_ID) 
   pre write_locks>0 and writer_id=tid
   is
      write_locks:=write_locks-1;
      if write_locks=0 then writer_id:=THREAD_ID::nil; end;
   end;

   r_release(tid:THREAD_ID) 
   pre read_locks>0
   is
      read_locks:=read_locks-1;
      readers_in_lock.delete(tid);
   end;

   wait_for(tid:THREAD_ID):ARRAY{THREAD_ID} is
      f:FSET{THREAD_ID};
      if tid/=writer_id and writer_id/=THREAD_ID::nil then
         f:=f.insert(writer_id);
      end;
      if read_locks>0 and tid/=writer_id then
	 loop f:=f.insert(readers_in_lock.elt!); end;
      end;
      if f.size>0 then
	 a::=#ARRAY{THREAD_ID}(f.size);
	 loop a.set!(f.elt!); end;
	 return a;
      end;
      return void;
   end;

   r_request(tid:THREAD_ID) is end;
   r_cancel_request(tid:THREAD_ID) is end;

   r_wait_for(tid:THREAD_ID):ARRAY{THREAD_ID} is
      if write_locks>0 and tid/=writer_id then
	 return |writer_id|;
      end;
      return void;
   end;
end;

class FRW_LOCK < $RW_LOCK is
   readonly attr reader:$READER_LOCK;
   readonly attr writer:$WRITER_LOCK;

   create:SAME is
      r::=new;
      w::=#FRW_WRITER;
      r.writer:=w;
      r.reader:=#RW_READER(w);
      LM_MULTIPLE_LOCK_MANAGER::create(|r.reader,r.writer|);
      return r;
   end;
end;

-- for symetric reasons:
class FWR_LOCK < $RW_LOCK is include FRW_LOCK; end;
   

-- Implements a reader writer locks where writers have 
-- precedence over writer.

-- Helper class for reader/writer locks. should not be used
-- outside of this library.
class WR_WRITER < $RW_WRITER is
   include FRW_WRITER r_wait_for->,r_acquirable->,request->,
   		      cancel_request->,init->frw_init,create->;

   private attr writers_waiting:FSET{THREAD_ID};

   create:SAME is
      r::=new;
      r.init;
      return r;
   end;

   init is
      frw_init;
   end;

   request(tid:THREAD_ID) is
      writers_waiting:=writers_waiting.insert(tid);
   end;

   cancel_request(tid:THREAD_ID) is
      writers_waiting:=writers_waiting.delete(tid);
   end;

   r_acquirable(tid:THREAD_ID):BOOL is
      return (write_locks=0 and (writers_waiting.size=0 or
	                         (writers_waiting.size=1 and
				  writers_waiting.first_elt=tid))) or
	      writer_id=tid;
   end;

   r_wait_for(tid:THREAD_ID):ARRAY{THREAD_ID} is
      s::=0;
      f:FSET{THREAD_ID};
      if tid/=writer_id and writer_id/=THREAD_ID::nil then
         f:=f.insert(writer_id);
      end;
      loop
         f:=f.insert(writers_waiting.elt!);
      end;
      f:=f.delete(tid); -- if the same thread is waiting at the
                        -- same time for a reader and a writer, 
			-- its ok.
      if f.size>0 then
	 a::=#ARRAY{THREAD_ID}(f.size);
	 loop
	    a.set!(f.elt!);
	 end;
	 return a;
      end;
      return void;
   end;
end;

class WR_LOCK < $RW_LOCK is
   readonly attr reader:$READER_LOCK;
   readonly attr writer:$WRITER_LOCK;

   create:SAME is
      r::=new;
      w::=#WR_WRITER;
      r.writer:=w;
      r.reader:=#RW_READER(w);
      LM_MULTIPLE_LOCK_MANAGER::create(|r.reader,r.writer|);
      return r;
   end;
end;

-- Implements a reader writer locks where readers have 
-- precedence over writer.

-- Helper class for reader/writer locks. should not be used
-- outside of this library.
class RW_WRITER < $RW_WRITER is
   include FRW_WRITER wait_for->,acquirable->,init->frw_init,create->;

   private attr readers_waiting:FSET{THREAD_ID};

   create:SAME is
      r::=new;
      r.init;
      return r;
   end;

   init is
      frw_init;
   end;

   r_request(tid:THREAD_ID) is
      readers_waiting:=readers_waiting.insert(tid);
   end;

   r_cancel_request(tid:THREAD_ID) is
      readers_waiting:=readers_waiting.delete(tid);
   end;

   acquirable(tid:THREAD_ID):BOOL is
      return (write_locks=0 and read_locks=0 and 
                (readers_waiting.size=0 or 
		  (readers_waiting.size=1 and readers_waiting.first_elt=tid))) or writer_id=tid;
   end;

   wait_for(tid:THREAD_ID):ARRAY{THREAD_ID} is
      s::=0;
      f:FSET{THREAD_ID};
      if tid/=writer_id and writer_id/=THREAD_ID::nil then
         f:=f.insert(writer_id);
      end;
      loop
         f:=f.insert(readers_waiting.elt!);
      end;
      f:=f.delete(tid); -- if the same thread is waiting at the
                        -- same time for a reader and a writer, 
			-- its ok.
      loop f:=f.insert(readers_in_lock.elt!); end;
      if f.size>0 then
	 a::=#ARRAY{THREAD_ID}(f.size);
	 loop
	    a.set!(f.elt!);
	 end;
	 return a;
      end;
      return void;
   end;
end;

class RW_LOCK < $RW_LOCK is
   readonly attr reader:$READER_LOCK;
   readonly attr writer:$WRITER_LOCK;

   create:SAME is
      r::=new;
      w::=#RW_WRITER;
      r.writer:=w;
      r.reader:=#RW_READER(w);
      LM_MULTIPLE_LOCK_MANAGER::create(|r.reader,r.writer|);
      return r;
   end;
end;
