------------------------->  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>  <--------------

partial class LM_LOCK_MANAGER_ACCESS < $LOCK is
   -- This class links a lock to a lock manager. While the lock manager
   -- beeing linked to a lock may change, an object of this class remains
   -- linked to the same single lock.
   -- Furthermore is provides a queue of waiting threads in local memory.
   -- This queue may be moved by a far lock manager which includes assigning
   -- the far reference to attr queue, but the local queue remains allocated
   -- and may be re-used when the far lock manager is changed to a local one.

   private attr my_manager:$LM_LOCK_MANAGER;
   private attr my_queue:LM_THREAD_HANDLE_QUEUE;
   private attr my_local_queue:LM_THREAD_HANDLE_QUEUE;

   -- Lock the manager referenced by .my_manager.
   get_manager:$LM_LOCK_MANAGER is
      if far(self) then return get_manager@where(self); end;
      if void(my_manager) then return my_manager; end;
      loop
         SYS::import;
         old_lm ::= my_manager;
         if near(old_lm) then
            old_lm.lck;
            SYS::import;
            -- While the thread was acquiring the lock,
            -- the manager might have changed.
            if SYS::ob_eq(old_lm,my_manager) then return old_lm; end;
            -- It has changed. The wrong manager was locked.
            -- Release it and try again.
            old_lm.release;
         else
            old_lm.lck@where(old_lm);
            SYS::import;
            -- While the thread was acquiring the lock,
            -- the manager might have changed.
            if SYS::ob_eq(old_lm,my_manager) then return old_lm; end;
            -- Release it and try again.
            old_lm.release@where(old_lm);
         end;
      end;
   end;

   -- Try locking the manager referenced by .my_manager.
   try_manager:$LM_LOCK_MANAGER is
      if far(self) then return try_manager@where(self); end;
      if void(my_manager) then return my_manager; end;
      loop
         SYS::import;
         old_lm ::= my_manager;
         if near(old_lm) then
            if ~old_lm.try then return void; end;
            SYS::import;
            -- While the thread was acquiring the lock,
            -- the manager might have changed.
            if SYS::ob_eq(old_lm,my_manager) then return old_lm; end;
            -- Release it and try again.
            old_lm.release;
         else
            if ~(old_lm.try@where(old_lm)) then return void; end;
            SYS::import;
            -- While the thread was acquiring the lock,
            -- the manager might have changed.
            if SYS::ob_eq(old_lm,my_manager) then return old_lm; end;
            -- Release it and try again.
            old_lm.release@where(old_lm);
         end;
      end;
   end;

   set_manager(lm:$LM_LOCK_MANAGER) is my_manager := lm; end;
   manager:$LM_LOCK_MANAGER is return my_manager; end;
   queue:LM_THREAD_HANDLE_QUEUE is return my_queue; end;

   init_queue pre ~void(self) is
      my_local_queue := #;
      my_queue := my_local_queue;
      my_queue.initialize_for_scanning;
   end;

   set_queue(q:LM_THREAD_HANDLE_QUEUE) pre my_manager.lm_is_locked is
      my_queue := q;
   end;

   local_queue:LM_THREAD_HANDLE_QUEUE pre my_manager.lm_is_locked is
      my_queue := my_local_queue; return queue;
   end;

   --=======================================================================
   -- Access functions: All lock statements call one of these functions
   -- when entering or leaving a lock statement. Requests concerning single
   -- locks are generated by the compiler directly. For requests concerning
   -- more than one lock, the cmpiler (still) generates a call to the
   -- external C interface in file lm_external.sa.
   -- All calls from outside the object are generated at the
   -- current thread's locus of execution.
   --=======================================================================

   --=======================================================================
   -- Requests concerning single locks only.
   --=======================================================================

   access_acquire_single_lock is
      manager ::= get_manager;
      if near(manager) then manager.acquire_single_lock(self);
      else manager.acquire_single_lock(self)@where(manager); end;
   end;

   access_try_single_lock:C_INT is
      manager ::= get_manager;
      if near(manager) then return manager.try_single_lock(self);
      else return manager.try_single_lock(self)@where(manager); end;
   end;

   access_release_single_lock is
      manager ::= get_manager;
      if near(manager) then manager.release_single_lock(self);
      else manager.release_single_lock(self)@where(manager); end;
   end;

   --=======================================================================
   -- Requests concerning double locks only, not useable yet.
   --=======================================================================

   -- The double lock methods are not useable yet.
   access_acquire_double_lock(lck2:QMUTEX) is
      manager ::= get_manager;
      if near(manager) then manager.acquire_single_lock(self);
      else remote_acquire_double_lock(manager); end;
   end;

   private remote_acquire_double_lock(manager:$LM_LOCK_MANAGER) is
      manager.acquire_single_lock(self)@where(manager); -- ???
   end;

   -- The double lock methods are not useable yet.
   access_try_double_lock(lck2:QMUTEX):C_INT is
      manager ::= get_manager;
      if near(manager) then return manager.try_single_lock(self);
      else return remote_try_double_lock(manager); end;
   end;

   private remote_try_double_lock(manager:$LM_LOCK_MANAGER):C_INT is
      return manager.try_single_lock(self)@where(manager); -- ???
   end;

   -- The double lock methods are not useable yet.
   access_release_double_lock(lck2:QMUTEX) is
      manager ::= get_manager;
      if near(manager) then manager.release_single_lock(self);
      else remote_release_double_lock(manager); end;
   end;

   private remote_release_double_lock(manager:$LM_LOCK_MANAGER) is
      manager.acquire_single_lock(self)@where(manager); -- ???
   end;

   --=======================================================================
   -- Conjunctive lock requests
   --=======================================================================

   access_acquire_conjunctive_locks(these_locks:EXT_OB,size:INT) is
      -- .these_locks is a pointer to a C array of lock references.
      -- Get the lock manager of the first lock.
      manager ::= get_manager;
      if near(manager) then
         local_acquire_conjunctive_locks(manager,these_locks,size);
      else
         -- contimue execution at the remote lock manager's cluster.
         locks_ptr:C_LONG;
         SYS::inlined_C("#locks_ptr = (long)these_locks;");
         remote_acquire_conjunctive_locks(manager,locks_ptr,size,here)
               @where(manager);
      end;
   end;

   private local_acquire_conjunctive_locks(manager:$LM_LOCK_MANAGER,
                                           these_locks:EXT_OB,size:INT) is
      -- If the lock manager does not control all locks of the statement,
      -- we create a new one that has to gain control.
      if ~manager.controls(these_locks,size) then
         -- Unlock the first lock's manager.
         manager.release;
         -- Create a new lock manager not yet linked to any lock.
         -- The new manager is already locked.
         manager := #LM_COMBINED_LOCKS_MANAGER(these_locks,size);
      end;
      typecase manager when $LM_COMBINED_LOCKS_MANAGER then
         manager.acquire_conjunctive_locks(these_locks,size);
      end;
   end;

   private remote_acquire_conjunctive_locks(manager:$LM_LOCK_MANAGER,
                               locks_ptr:C_LONG,size:INT,from_cluster:INT) is
      -- This method is called local to the manager.
      -- Copy remote C array of locks to local memory.
      these_locks ::= get_remote_c_array_of_locks(locks_ptr,size,from_cluster);
      -- Call the original method, now locally.
      local_acquire_conjunctive_locks(manager,these_locks,size);
      -- Free the allocated array.
      SYS::inlined_C("free(#these_locks);");
   end;

   access_try_conjunctive_locks(these_locks:EXT_OB,size:INT):C_INT is
      -- .these_locks is a pointer to a C array of lock references.
      -- Get the lock manager of the first lock.
      manager ::= get_manager;
      if near(manager) then
         return local_try_conjunctive_locks(manager,these_locks,size);
      else
         -- contimue execution at the remote lock manager's cluster.
         locks_ptr:C_LONG;
         SYS::inlined_C("#locks_ptr = (long)these_locks;");
         return remote_try_conjunctive_locks(manager,locks_ptr,size,here)
               @where(manager);
      end;
   end;

   private local_try_conjunctive_locks(manager:$LM_LOCK_MANAGER,
                                   these_locks:EXT_OB,size:INT):C_INT is
      -- If the lock manager does not control all locks of the statement,
      -- we create a new one that has to gain control.
      if ~manager.controls(these_locks,size) then
         -- Unlock the first lock's manager.
         manager.release;
         -- Create a new lock manager not yet linked to any lock.
         -- The new manager is already locked.
         manager := #LM_COMBINED_LOCKS_MANAGER(these_locks,size);
      end;
      typecase manager when $LM_COMBINED_LOCKS_MANAGER then
         return manager.try_conjunctive_locks(these_locks,size);
      end;
   end;

   private remote_try_conjunctive_locks(manager:$LM_LOCK_MANAGER,
                          locks_ptr:C_LONG,size:INT,from_cluster:INT):C_INT is
      -- This method is called local to the manager.
      -- Copy remote C array of locks to local memory.
      these_locks ::= get_remote_c_array_of_locks(locks_ptr,size,from_cluster);
      -- Call the original method, now locally.
      ret_val ::= local_try_conjunctive_locks(manager,these_locks,size);
      -- Free the allocated array.
      SYS::inlined_C("free(#these_locks);");
      return ret_val;
   end;

   access_release_conjunctive_locks(these_locks:EXT_OB,size:INT) is
      -- .these_locks is a pointer to a C array of lock references.
      -- Get the lock manager of the first lock.
      manager ::= get_manager;
      if near(manager) then
         local_release_conjunctive_locks(manager,these_locks,size);
      else
         -- contimue execution at the remote lock manager's cluster.
         locks_ptr:C_LONG;
         SYS::inlined_C("#locks_ptr = (long)these_locks;");
         remote_release_conjunctive_locks(manager,locks_ptr,size,here)
               @where(manager);
      end;
   end;

   private local_release_conjunctive_locks(manager:$LM_LOCK_MANAGER,
                                   these_locks:EXT_OB,size:INT) is
      -- If the lock manager does not control all locks of the statement,
      -- we create a new one that has to gain control.
      if ~manager.controls(these_locks,size) then
         -- Unlock the first lock's manager.
         manager.release;
         -- Create a new lock manager not yet linked to any lock.
         -- The new manager is already locked.
         manager := #LM_COMBINED_LOCKS_MANAGER(these_locks,size);
      end;
      typecase manager
      when $LM_COMBINED_LOCKS_MANAGER then
         manager.release_conjunctive_locks(these_locks,size);
      when $LM_SINGLE_LOCK_MANAGER then
         -- In this rare case we start accessing the lock manager again
         -- with the correct access function. This is necessary because
         -- The MANAGER_INCLUDE partial classes overload this access method,
         -- but they do not overload access_release_conjunctive_locks.
         -- First, the manager has to be released.
         manager.release;
         -- Release the lock and check, if waiting threads can be reactivated.
         -- The lock to be released is self.
         access_release_single_lock;
      end;
   end;

   private remote_release_conjunctive_locks(manager:$LM_LOCK_MANAGER,
                               locks_ptr:C_LONG,size:INT,from_cluster:INT) is
      -- This method is called local to the manager.
      -- Copy remote C array of locks to local memory.
      these_locks ::= get_remote_c_array_of_locks(locks_ptr,size,from_cluster);
      -- Call the original method, now locally.
      local_release_conjunctive_locks(manager,these_locks,size);
      -- Free the allocated array.
      SYS::inlined_C("free(#these_locks);");
   end;

   access_acquire_disjunctive_locks(stmt:EXT_OB):C_INT is
      -- stmt is supposed to be of type EXCEPT_LOCK_ELEMENT(n).
      -- Get the lock manager of the first lock.
      manager ::= get_manager;
      --#OUT + (" Lock Array erzeugt mit " + locks.asize + " Klauseln.\n");
      --   #OUT + (" Klausel "+i +" hat "+locks[i].asize+" Eintraege.\n");
      -- If the lock manager does not control all locks of the statement,
      -- we create a new one that has to gain control.
      -- Read the entries of the exception stack element.
      locks:EXT_OB;
      SYS::inlined_C("#locks = ((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->locks;");
      max_size_c:C_INT;
      SYS::inlined_C("#max_size_c = ((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->cols;");
      max_size ::= max_size_c.int;
      clauses_c:C_INT;
      SYS::inlined_C("#clauses_c = ((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->branches;");
      clauses ::= clauses_c.int;
      if ~manager.controls(locks,max_size*clauses) then
         -- Unlock the first lock's manager.
         manager.release;
         -- Create a new lock manager not yet linked to any lock.
         -- The new manager is already locked.
         manager := #LM_COMBINED_LOCKS_MANAGER(locks,max_size*clauses);
      end;
      typecase manager when $LM_COMBINED_LOCKS_MANAGER then
         else_clause:BOOL;
         SYS::inlined_C(
         "#else_clause=((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->flags&LOCK_WITH_ELSE;");
         return manager.acquire_disjunctive_locks(locks,max_size,clauses);
      end;
      return #C_INT(0);
   end;

   access_try_disjunctive_locks(stmt:EXT_OB):C_INT is
      -- stmt is supposed to be of type EXCEPT_LOCK_ELEMENT(n).
      -- Get the lock manager of the first lock.
      manager ::= get_manager;
      --#OUT + (" Lock Array erzeugt mit " + locks.asize + " Klauseln.\n");
      --   #OUT + (" Klausel "+i +" hat "+locks[i].asize+" Eintraege.\n");
      -- If the lock manager does not control all locks of the statement,
      -- we create a new one that has to gain control.
      -- Read the entries of the exception stack element.
      locks:EXT_OB;
      SYS::inlined_C("#locks = ((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->locks;");
      max_size_c:C_INT;
      SYS::inlined_C("#max_size_c = ((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->cols;");
      max_size ::= max_size_c.int;
      clauses_c:C_INT;
      SYS::inlined_C("#clauses_c = ((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->branches;");
      clauses ::= clauses_c.int;
      if ~manager.controls(locks,max_size*clauses) then
         -- Unlock the first lock's manager.
         manager.release;
         -- Create a new lock manager not yet linked to any lock.
         -- The new manager is already locked.
         manager := #LM_COMBINED_LOCKS_MANAGER(locks,max_size*clauses);
      end;
      typecase manager when $LM_COMBINED_LOCKS_MANAGER then
         else_clause:BOOL;
         SYS::inlined_C(
         "#else_clause=((EXCEPT_LOCK_ELEMENT(1)*)(#stmt))->flags&LOCK_WITH_ELSE;");
         return manager.try_disjunctive_locks(locks,max_size,clauses);
      end;
      return #C_INT(0);
   end;

   private get_remote_c_array_of_locks(remote_ptr:C_LONG,size:INT,
      from_cluster:INT):EXT_OB is builtin GET_REMOTE_C_ARRAY; end;

   -- Can't avoid inserting these stubs:
   stub acquirable(tid:THREAD_ID):BOOL;
   stub acquire(tid:THREAD_ID);
   stub release(tid:THREAD_ID);
   stub request(tid:THREAD_ID);
   stub cancel_request(tid:THREAD_ID);
   stub wait_for(tid:THREAD_ID):ARRAY{THREAD_ID};
   stub combinations:ARRAY{ARRAY{$LOCK}};
   stub combined_with(lcks:ARRAY{$LOCK},tids:ARRAY{THREAD_ID});

end;


class LM_LOCK_C_ARRAY is
   -- This class provides acceess to a C array of $LOCK references.

   get(locks:EXT_OB,index:INT):$LOCK is
      -- Return element .index of array .locks.
      lck:$LOCK;
      SYS::inlined_C(
      "#lck=(void*)(((void**)#locks)[#index]);");
      return lck;
   end;

   get_num(locks:EXT_OB,index:INT):INT is
      -- Return element .index of array .locks.
      ptr:INT;
      SYS::inlined_C(
      "#ptr=(long)(((long*)#locks)[#index]);");
      return ptr;
   end;

   elt!(once locks:EXT_OB,once size:INT):$LOCK is
      -- Yield the first .size elements of array .locks.
      loop yield get(locks,0.upto!(size-1)); end;
   end;

   elt_num!(once locks:EXT_OB,once size:INT):INT is
      -- Yield the first .size elements of array .locks.
      loop yield get_num(locks,0.upto!(size-1)); end;
   end;

   elt_no_void!(once locks:EXT_OB,once size:INT):$LOCK is
      -- Yield the first .size elements of array .locks.
      -- Quit if an element is void.
      loop lck ::= get(locks,0.upto!(size-1));
         if void(lck) then quit; else yield lck; end;
      end;
   end;

   get_array(locks:EXT_OB,array_size:INT,index:INT):EXT_OB is
      -- .locks is of type void*[array_size][]. Return the .index-th
      -- one-dimensional array of the two-dimensional array .locks.
      lock_array:EXT_OB;
      SYS::inlined_C("#lock_array = (void*)((void**)#locks + INTC_INT(#array_size)*INTC_INT(#index));");
      return lock_array;
   end;

   arrays!(once locks:EXT_OB, once array_size:INT, once arrays:INT):EXT_OB is
      -- .locks is of type void*[array_size][]. Return the first .arrays
      -- one-dimensional arrays of the two-dimensional array .locks.
      loop yield get_array(locks,array_size,0.step!(arrays,array_size)); end;
   end;

   array_size(locks:EXT_OB,max_size:INT):INT is
      -- Scan the first .max_size elements of array .locks and return the
      -- number of consecutive non-void elements. Return 0 if the first element
      -- is void.
      size ::= 0;
      loop lck ::= elt!(locks,max_size);
         if ~void(lck) then size := size + 1; else break! end;
      end;
      return size;
   end;
end;
