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

class LM_REF_C_INT is
   -- Just a reference to an integer.
   attr val:C_INT;
   create:SAME is r::=new; r.val:=#C_INT(0); return r; end;
end; -- class LM_REF_C_INT

immutable class LM_LOCK_HANDLE is
   attr lck:$LOCK;
   attr queue:LM_THREAD_HANDLE_QUEUE;
   create(l:$LOCK,q:LM_THREAD_HANDLE_QUEUE):SAME is
      return lck(l).queue(q);
   end;
   is_eq(lhl:SAME):BOOL is
      return SYS::ob_eq(lck,lhl.lck) and SYS::ob_eq(queue,lhl.queue);
   end;
end; -- class LM_LOCK_HANDLE

class LM_SCAN_STATE is
   attr tag:LM_THREAD_HANDLE_EXTENSION;  -- Identifying a group of conj. entries.
   attr dead:BOOL;         -- true, if the conjunctive request has already failed.
   attr blocking:BOOL;     -- true, if the request blocks all successors.
   attr blocked:BOOL;      -- true, if the request is blocked by others.
   attr queues:A_QUEUE{LM_THREAD_HANDLE_QUEUE};    -- List of queues that still
                                                   -- have to be scanned.
   create:SAME is return new; end;
   create(t:LM_THREAD_HANDLE_EXTENSION):SAME is r::=new; r.tag:=t; return r; end;
end; -- class LM_SCAN_STATE

class LM_COMBINED_LOCKS_MANAGER < $LM_COMBINED_LOCKS_MANAGER is
   include LM_MULTIPLE_LOCK_MANAGER create->;
   -- List and index array used for checking queues.
   private attr unchecked_queues:FLIST{LM_THREAD_HANDLE_QUEUE};
   -- List of the lock managers that were taken over.
   private attr replaced_managers:FLIST{$LM_LOCK_MANAGER};
   private attr reserved_managers:FLIST{$LM_LOCK_MANAGER};

   create(these_locks:EXT_OB,size:INT):SAME is
      -- This constructor is invoked, when a new lockmanager is required
      -- to control a complex lock statement.
      ret ::= new;
      ret.lm_init;
      ret.ll_mutex.lck;         -- This manager is locked initially.
      ret.lm_is_locked := true;
      ret.get_control(these_locks,size);
      ret.take_over;
      return ret;
   end; -- create(these_locks:EXT_OB,size:INT):SAME

   controls(these_locks:EXT_OB,size:INT):BOOL pre lm_is_locked is
      -- .these_locks is a pointer to a C array of $LOCK references.
      -- Test if all locks of array .these_locks are managed by self.
      -- Return false, if one of the locks is mot managed by self.
      loop a_lock ::= LM_LOCK_C_ARRAY::elt!(these_locks,size);
         if ~void(a_lock) then
            if ~SYS::ob_eq(self,a_lock.manager) then return false; end;
         end;
      end;
      return true;
   end; -- controls(these_locks:EXT_OB,size:INT):BOOL

   private get_control(locks:EXT_OB,size:INT) is
      -- Get control over all locks in array 'these_locks'. Try to lock every
      -- lock's manager. This may be a problem when several threads are trying
      -- to lock non-disjunctive sets of locks at the same time, e.g. after a sync.

      -- The applied strategy is the following:
      -- First, this manager simply tries to get control over all required
      -- managers by locking them. If this works, it's fine and the fastest way.
      -- If it fails, it releases all managers that has been locked so far
      -- and waits for an amount of time depending on the value of .waiting_time
      -- before it tries to lock the managers again until it succeeds.
      -- The value of .waiting_time is doubled for each try.
      -- To avoid synchronous waiting and trying of concurrent threads
      -- the real waiting time is a random value between 0 and .waiting_time.

      --if ~try_locking_managers(locks,size) then #OUT+"Fehler:\n";
         lock_sorted_managers(locks,size);
      --end;
   end; -- get_control(these_locks:EXT_OB,size:INT)

   private lock_sorted_managers(locks:EXT_OB,size:INT) is
      tid ::= THREAD_ID::me;
      -- Temporary list of all managers to be locked.
      -- There cannot be more managers than locks.
      managers ::= #FLIST{$LM_LOCK_MANAGER}(size);
      -- loop until all lock's managers are locked.
      loop
         got_them_all ::= true;
         -- Which and how many managers are reqired.
         loop a_lock :$LOCK:= LM_LOCK_C_ARRAY::elt!(locks,size);
            if ~void(a_lock) then
               manager ::= a_lock.manager;
               if ~managers.has(manager) then
                  managers := managers.push(manager);
               end;
            end;
         end;
         -- Bubble sort the array.
         c_bool:C_INT;
         loop k ::= (managers.size-1).downto!(1);
            max_index ::= 0;
            max_man ::= managers[0];
            loop j ::= 1.upto!(k);
               man1 ::= managers[j];
               SYS::inlined_C(
                  "#c_bool = (unsigned long)#man1 > (unsigned long)#max_man;");
               if c_bool = #C_INT(0) then
                  max_man := man1;
                  max_index := j;
               end;
	    end;
            -- Swap the max and the first.
            managers[max_index] := managers[k];
            managers[k] := max_man;
         end;
         -- Lock all managers in the new order.
         loop managers.elt!.lck; end;
         -- Check, if they still are the right managers.
	 -- Check1: Has one of the managers been taken over yet?
	 loop if managers.elt!.taken_over then got_them_all := false; end; end;
	 -- Check2: Have all locks' managers been locked?
         loop a_lock :$LOCK:= LM_LOCK_C_ARRAY::elt!(locks,size);
            if ~void(a_lock) then
               found_it ::= false;
               loop
                  if SYS::ob_eq(managers.elt!,a_lock.manager) then
                     found_it := true;
                     break!
                  end;
               end;
               if found_it = false then
                  got_them_all := false;
                  break!;
               end;
            end; -- if ~void
         end; -- loop alock
         -- Complete success?
         if got_them_all then
	    loop
               replaced_managers := replaced_managers.push(managers.elt!);
	    end;
            return;
         else
	    -- Release them all and try again.
	    loop managers.elt!.release; end;
	    -- Clear the array for the next loop.
	    managers.reset;
	 end;
      end; -- loop
   end; -- lock_sorted_managers(locks:EXT_OB,size:INT)

   private try_locking_managers(locks:EXT_OB,size:INT):BOOL is
      tid ::= THREAD_ID::me;                                    --OU(
      -- Temporary list of all locks.
      all_locks ::= #FLIST{$LOCK}(size);
      -- Set list of all locks.
      SYS::inlined_C("printf(\"size %d.\n\",#size);");
      loop a_lock :$LOCK:= LM_LOCK_C_ARRAY::elt!(locks,size);
         SYS::inlined_C("printf(\".\");");
         if ~void(a_lock) then
            SYS::inlined_C("printf(\"-\");");
            if ~all_locks.has(a_lock) then
               SYS::inlined_C("printf(\"+\");");
               all_locks := all_locks.push(a_lock); end; end;
      end;
      SYS::inlined_C("printf(\"\n\");");
      -- Loop over all elements of all_locks.
      loop while!(~all_locks.is_empty);
         -- Try to lock the manager of the first lock in the list.
         SYS::inlined_C("printf(\".\");");
         manager ::= all_locks.top.try_manager;
         if void(manager) then
            SYS::inlined_C("printf(\"-\");");
            -- Unlock everything that has been locked yet.
            loop replaced_managers.elt!.release; end;
            -- Reset the list of managers.
            replaced_managers.reset;
            return false;
         else
            SYS::inlined_C("printf(\"+\");");
            -- Manager has been locked.
            replaced_managers := replaced_managers.push(manager);
            -- Remove elements from all_locks, that are managed by this manager.
            loop a_lock ::= manager.managed_locks.elt!;
               SYS::inlined_C("printf(\":\");");
               if all_locks.has(a_lock) then SYS::inlined_C("printf(\"!\");"); all_locks.delete_elt(a_lock) end;
            end;
         end; -- if void(manager)
         SYS::inlined_C("printf(\"\n\");");
      end; -- loop while!(~all_locks.is_empty)
      return true;
   end; -- try_locking_managers(locks:EXT_OB,size:INT):BOOL

   private take_over is
      -- This method is called after all lock managers in .replaced_mamagers
      -- have been acquired. For all locks managed by these managers, the
      -- pointers to their respective lock manager are set to .self and their
      -- old lock managers are unlocked.
      -- Since some of the locks might share one lock manager, a list of all
      -- locks is created. Each time, a manager has been locked, all locks
      -- beeing controlled by this manager are removed from the list. This
      -- procedure seems to be less effective than checking for each lock
      -- if its manager is already locked (the number of managers might be
      -- smaller thah the number of locks), but assuming a worst case where
      -- all locks and managers are far, the network traffic is lower when this
      -- procedure is used.

     -- Initialize counters.
      holding_threads_counter := 0;
      waiting_requests_counter := 0;
      -- Temporary lists.
      flist_of_locks:FLIST{$LOCK};
      flist_of_queues:FLIST{LM_THREAD_HANDLE_QUEUE};
      -- Loop over all replaced lock managers.
      loop manager ::= replaced_managers.elt!;
	 -- Mark the manager to be taken over.
	 manager.taken_over(true);
         -- Loop over all locks and queues controlled by this manager.
         loop ind ::= manager.managed_locks.ind!;
            a_lock ::= manager.managed_locks[ind];
            -- Add the lock and the queue to the respective new list.
            flist_of_locks := flist_of_locks.push(a_lock);
            flist_of_queues := flist_of_queues.push(manager.managed_queues[ind]);
            -- Set the lock's pointer to the new master.
            a_lock.set_manager(self);
         end;
         -- Add the number of threads holding locks to the thread counter.
         holding_threads_counter :=
               holding_threads_counter + manager.number_of_threads_holding_locks;
         -- Unlock all replaced managers. This is important for other threads
         -- having tried to lock them meanwhile.
         manager.release;
      end; -- loop replaced_managers.elt!
      -- Set the arrays managed_locks, managed_queues.
      managed_locks := flist_of_locks.array;
      managed_queues := flist_of_queues.array;
      -- Determine the number of waiting requests.
      loop waiting_requests_counter := INT::sum!(managed_queues.elt!.size); end;
   end; -- take_over

   acquire_conjunctive_locks(locks:EXT_OB,size:INT) pre lm_is_locked is
      if try_conjunctive_locks_internally(locks,size) then release; return; end;
      -- Now we enqueue a conjunctive request.
      -- Create a low level lock and lock it.
      sleeper ::= #LL_LOCK;
      sleeper.lck;
      -- Create a reference object to store which of the when clauses is acquired.
      clause ::= #LM_REF_C_INT;
      -- Create a two-dimensional array of lock handles from .locks.
      -- The array is filled during enqueuing the conjunctive requests.
      handles ::= #ARRAY{ARRAY{LM_LOCK_HANDLE}}(1);
      enqueue_conjunctive_request(locks,size,0,handles,sleeper,clause);
      -- Release the lock manager.
      release;
      -- Wait until sleeper becomes unlocked.
      sleeper.lck;
      -- Continue thread execution.
   end; -- acquire_conjunctive_locks(locks:EXT_OB,size:INT)

   try_conjunctive_locks(locks:EXT_OB,size:INT):C_INT pre lm_is_locked is
      ret_val ::= #C_INT(0);
      if try_conjunctive_locks_internally(locks,size) then ret_val:=#C_INT(1); end;
      -- Release the lock manager.
      release;
      return ret_val;
   end; -- try_conjunctive_locks(locks:EXT_OB,size:INT):C_INT

   private try_conjunctive_locks_internally(locks:EXT_OB,size:INT):BOOL is
      -- Get the thread ID.
      tid ::= THREAD_ID::me;
      -- Check, if all locks are acquirable, break if one isn't.
--      loop if ~LM_LOCK_C_ARRAY::elt!(locks,size).acquirable(tid) then
--          return false; end; end;
      loop lll ::= LM_LOCK_C_ARRAY::elt!(locks,size);
         if (~(lll.acquirable(tid))) then
--            #ERR+("Thread "+tid.str+" cannot acquire lock "+SYS::id(lll)+".\n");
            return false;
--         else
--            #ERR+("Thread "+tid.str+" can acquire lock "+SYS::id(lll)+".\n");
         end;
      end;
      -- Is there any entry in one of the corresponding queues?
      -- Return if there is one and if the queue is blocking.
      loop if ~LM_LOCK_C_ARRAY::elt!(locks,size).queue.not_blocked then
         return false; end; end;
      -- Acquire all locks and keep the new states.
      loop LM_LOCK_C_ARRAY::elt!(locks,size).acquire(tid); end;
      --Adjust the lock counter.
      holding_threads_counter := holding_threads_counter + 1;
      return true;
   end; -- private try_conjunctive_locks_internally(these_locks:EXT_OB):BOOL

   private enqueue_conjunctive_request(locks:EXT_OB,max_size:INT,clause:INT,
                               lock_handles:ARRAY{ARRAY{LM_LOCK_HANDLE}},
                               sleeper:LL_LOCK,write_back:LM_REF_C_INT) is
      -- Get the thread ID.
      tid ::= THREAD_ID::me;
      -- Check the size of the request.
      size ::= LM_LOCK_C_ARRAY::array_size(locks,max_size);
      -- Create an array of lock handles for this request.
      lock_handles[clause] := #ARRAY{LM_LOCK_HANDLE}(size);
      -- Create a thread handle extension for all conjunctive requests.
      handle_ext ::= #LM_THREAD_HANDLE_EXTENSION;
      -- Fill in all necessary information.
      handle_ext.linked_locks := lock_handles;
      handle_ext.when_clause := clause;
      handle_ext.clause_write_back := write_back;
      handle_ext.handles := size;
      -- Loop over all locks.
      loop i ::= 0.upto!(size-1);
         a_lock ::= LM_LOCK_C_ARRAY::get(locks,i);
         until!(void(a_lock));
         -- Create a lock handle.
         lock_handles[clause][i] := #LM_LOCK_HANDLE(a_lock,a_lock.queue);
         -- Create a thread handle.
         t_handle ::= #LM_THREAD_HANDLE(THREAD_ID::me,sleeper,a_lock);
         -- That's what I like with immutable classes: all set by one line.
         t_handle := t_handle.ext(handle_ext).lock_index(i);
         a_lock.queue.enq(t_handle);
         -- Inform the lock about the request.
         a_lock.request(tid);
         -- Adjust the counter of waiting requests.
         waiting_requests_counter := waiting_requests_counter + 1;
      end; -- loop locks.ind!
   end; -- private enqueue_conjunctive_request( ... )

   release_conjunctive_locks(locks:EXT_OB,size:INT) pre lm_is_locked is
      -- Release a set of conjunctive locks.
      loop
         a_lock ::= LM_LOCK_C_ARRAY::elt_no_void!(locks,size);
         a_lock.release(THREAD_ID::me);
      end;
      --Adjust the lock counter.
      holding_threads_counter := holding_threads_counter - 1;
      -- Check if some waiting threads can acquire their locks.
      check_all_locks;
      -- Release the lock manager.
      release;
   end; -- release_conjunctive_locks(locks:EXT_OB,size:INT)

   acquire_disjunctive_locks(locks:EXT_OB,max_size:INT,clauses:INT):C_INT
      pre lm_is_locked is
      chosen_clause ::= try_disjunctive_locks_internally(locks,max_size,clauses);
      if chosen_clause >= 0 then release; return #C_INT(chosen_clause); end;
      -- OK, now we enqueue a conjunctive request for each when clause.
      -- Create a low level lock and lock it.
      sleeper ::= #LL_LOCK;
      sleeper.lck;
      -- Create a reference object storing which when clauses is acquired.
      clause ::= #LM_REF_C_INT;
      -- Create a two-dimensional array of lock handles from .locks.
      -- The array is filled during enqueuing the conjunctive requests.
      handles ::= #ARRAY{ARRAY{LM_LOCK_HANDLE}}(clauses);
      -- All requests use the same low level lock.
      loop cl ::= 0.upto!(clauses-1);
         lock_arr ::= LM_LOCK_C_ARRAY::get_array(locks,max_size,cl);
         enqueue_conjunctive_request(lock_arr,max_size,cl,handles,sleeper,clause);
      end;
      -- Release the lock manager.
      release;
      -- Wait until sleeper becomes unlocked.
      sleeper.lck;
      -- Continue thread execution.
      return clause.val;
   end; -- acquire_disjunctive_locks(locks:EXT_OB,max_size:INT,clauses:INT):C_INT

   try_disjunctive_locks(locks:EXT_OB,max_size:INT,clauses:INT):C_INT
      pre lm_is_locked is
      chosen_clause ::= try_disjunctive_locks_internally(locks,max_size,clauses);
      if chosen_clause >= 0 then release; return #C_INT(chosen_clause); end;
      release;
      return #C_INT(-1);
   end; -- try_conjunctive_locks(locks:EXT_OB,size:INT):C_INT

   private try_disjunctive_locks_internally(locks:EXT_OB,max_size:INT,
                                            clauses:INT):INT is
      -- Create an array to store locality information.
      clause_is_local ::= #ARRAY{BOOL}(clauses);
      -- Create an array storing the sizes of the when clauses.
      clause_size ::= #ARRAY{INT}(clauses);
      -- Test localisty of when clauses.
      loop cl ::= 0.upto!(clauses-1);
         clause_is_local[cl] := true;
         clause_size[cl] := 0;
         lock_array ::= LM_LOCK_C_ARRAY::get_array(locks,max_size,cl);
         loop a_lock ::= LM_LOCK_C_ARRAY::elt_no_void!(lock_array,max_size);
            if far(a_lock) then clause_is_local[cl] := false; end;
            clause_size[cl] := clause_size[cl] + 1;
         end;
      end; -- loop i ::= locks.ind!
      -- Try to acquire one of the local when clauses.
      loop cl ::= 0.upto!(clauses-1);
         if clause_is_local[cl] then
            lock_array ::= LM_LOCK_C_ARRAY::get_array(locks,max_size,cl);
            if try_conjunctive_locks_internally(lock_array,clause_size[cl]) then
               return cl;
            end;
         end;
      end;
      -- No success. Now, we try the far ones.
      loop cl ::= 0.upto!(clauses-1);
         if ~clause_is_local[cl] then
            lock_array ::= LM_LOCK_C_ARRAY::get_array(locks,max_size,cl);
            if try_conjunctive_locks_internally(lock_array,clause_size[cl]) then
               return cl;
            end;
         end;
      end;
      return -1;
   end; -- try_disjunctive_locks_intern(locks:EXT_OB,max_size:INT,clauses:INT):INT

   -- Overriding the "multiple" version.
   private check_all_locks is
      -- The following policy is applied:
      -- 1. Scan all queues from the beginning.
      -- 2. If a thread beeing scanned is waiting for a single lock that is not
      --    to be locked in conjunction with others:
      --  2a. if it can acquire the lock, it will and scanning is stopped
      --      for this queue.
      --  2b. if it cannot acquire the lock, method get_older is called for this
      --      request to decide, whether this thread is skipped and scanning is
      --      continued for this queue, or scanning is stopped for this queue
      --      which means that this thread blocks other trailing threads.
      -- 3. If a thread beeing scanned is waiting for a lock that is to be
      --    locked in conjunction with others:
      --      If the thread is not the last of all conjunctive entries in
      --      different queues beeing scanned, scanning is interrupted for this
      --      queue until the last of the conjunctive entries is beeing scanned.
      --      Then all locks are checked to be acquirable. If all are, the thread
      --      acquires them and scanning is stopped for all concerned queues.
      --      If al least one of the locks cannot be acquired, method get_older
      --      is called for this request to decide, whether this request is
      --      skipped and scanning is continued for all concerned queues,
      --      or scanning is stopped for the queues meaning that this thread
      --      blocks other trailing threads.
      -- Implementation:
      -- a. Start with the set of all queues.
      -- b. While there is a queue left, select one and call method scan_queue.
      --         ... comments continued in mehtod scan_queue.

      scan_queues;
      -- Check if there is a possibility of starvation.
      if  holding_threads_counter = 0  and  waiting_requests_counter > 0  then
         LM_THREAD_HANDLE_EXTENSION::never_block;
         scan_queues;
         LM_THREAD_HANDLE_EXTENSION::allow_blocking;
      end;
   end; -- check_all_locks

   private scan_queues is
      -- Create an array of queue handles.
      unchecked_queues := #(managed_queues);
      -- Reset all queues' cursors.
      loop unchecked_queues.elt!.initialize_for_scanning; end;
      -- Loop until list of queues is empty.
      loop while!(~unchecked_queues.is_empty);
         -- Scan this queue. To control this operation a scan state is created.
         scan_queue(unchecked_queues.top,#LM_SCAN_STATE);
      end;
   end; -- scan_queues

   private scan_queue(queue:LM_THREAD_HANDLE_QUEUE,state:LM_SCAN_STATE)
      pre lm_is_locked is
      -- Scan the queue for a thread that can acquire this lock.
      -- This is an awfully long method with too many nested if's.
      -- The decision how to proceed depends always on many things,
      -- most of which are inculded in .state.
      --

      -- ***********************  INITIAL CHECK  *************************
      -- Has the queue already been scanned?
      if unchecked_queues.index_of(queue) < 0 then
         queue_is_blocked(queue,0,state);
         return;
      end;
      -- **********************  END INITIAL CHECK  ************************

      -- Loop over all entries of the queue.
      loop i ::= queue.cursor!;

         -- *************************  MAIN LOOP  ***************************
         -- Reference to the thread handle:
         thl:LM_THREAD_HANDLE := queue[i];
         -- Is this entry independent (not linked by conjunction)?
         if void(thl.ext) then

            -- ********************  INDEPENDENT ENTRY  **********************
            -- Check if the thread can acquire this lock.
            if queue[i].this_lock.acquirable(queue[i].tid) then
               get_lock(queue,i,true);
            end;
            -- An independent entry that is not acquirable is skipped.
            -- Conttinue scanning the queue.
            -- ******************  END INDEPENDENT ENTRY  ********************

         else -- if void(thl.ext)

            -- **********************  DEPENDENT ENTRY  **********************
            -- It's a dependent entry. Is it the seeked one, i.e. is it
            -- conjunctive with the entry from which scan_queue was invoked??
            if SYS::ob_eq(state.tag,thl.ext) then

               -- ***********************  A SEEKED ONE  ***********************
               -- Found it. Does it make sense to ask, whether it is acquirable?
               --if ~state.dead then
                  -- (This could be implemented more elegant, but this way
                  -- communication with a possibly far lock is reduced.)
               lock_is_acquirable ::= thl.this_lock.acquirable(thl.tid);
               if ~lock_is_acquirable then state.dead := true; end;
               -- Now state.dead considers also this lock.
               -- Is it the last conjunctive entry?
               last_one ::= state.queues.is_empty;
               if ~last_one then
                  -- It is not the last entry. Continue the search.
                  scan_queue(state.queues.remove,state);
               else
                  -- It is the last one. Check, if the request has become obsolete.
                  if thl.ext.obsolete then state.dead := true; end;
               end;

               -- Now, let's check what we've got.
               if state.dead then
                  -- It's dead. If it blocks, break, otherwise skip it.
                  if last_one then state.blocking := thl.ext.get_older; end;
                  -- Block only if the lock is acquirable.
                  if state.blocking and lock_is_acquirable then
                     -- This queue is not to be scanned any further.
                     unchecked_queues.delete(unchecked_queues.index_of(queue));
                  else -- if state.blocking
                     -- Start at the next entry when scanning of this queue
                     -- is continued.
                     queue.increase_cursor;
                  end; -- if state.blocking
               else -- if state.dead
                  -- OK, get it.
                  get_lock(queue,i,false);
               end; -- if state.dead
               return;
               -- *********************  END A SEEKED ONE  *********************

            else -- if SYS::ob_eq(state.tag,thl.ext)

               -- *******************  NEW DEPENDENT ENTRY  ********************
               -- Since it is not the seeked one, it is one that has not been
               -- visited before. It has to be e checked completely before
               -- scanning for the seeked one can be continued.

               -- Is the entry obsolete? Then this is a good time to remove it.
               -- An entry can becomes obsolete, if it belongs to one of a set of
               -- disjunctive requests and if one of these requests is
               -- granted. Then all other requests are obsolete.
               if thl.ext.obsolete then delete_obsolete_request(thl.ext);
               else
                  -- A recursive scan is necessary.
                  -- To control this operation a new scan state is created.
                  new_scan_state ::= #LM_SCAN_STATE(thl.ext);
                  -- Set the dead flag depending on the lock's reservability.
                  lock_is_acquirable ::= thl.this_lock.acquirable(thl.tid);
                  new_scan_state.dead := ~lock_is_acquirable;
                  -- Is there a conjunction with other locks?
                  if thl.ext.linked_locks[thl.ext.when_clause].asize > 1 then
                     -- Create a queue of queues to scan.
                     q_queue ::= A_QUEUE{LM_THREAD_HANDLE_QUEUE}::create_capacity(
                                                                thl.ext.handles-1);
                     -- A fake of a handle of this queue, required for comparison.
                     me ::= #LM_LOCK_HANDLE(thl.this_lock,queue);
                     loop lock_handle ::=
                        thl.ext.linked_locks[thl.ext.when_clause].elt!;
                        if lock_handle /= me then
                           q_queue.enq(lock_handle.queue); end;
                     end;
                     new_scan_state.queues := q_queue;
                     -- Scan recursively the queues containing
                     -- the conjunctive entries.
                     scan_queue(q_queue.remove,new_scan_state);
                  end; -- if thl.ext.linked_locks[...].asize > 1
                  -- Now, let's check what we've got.
                  -- Has the entry become obsolete? If yes, delete it.
                  if thl.ext.obsolete then delete_obsolete_request(thl.ext);
                  else
                     -- Id the entry dead?
                     if new_scan_state.dead then
                        -- It's dead. If it blocks, break, otherwise skip it.
                        -- Block only if the lock is acquirable.
                        if new_scan_state.blocking and lock_is_acquirable then
                           -- This queue is not to be scanned any further.
                           if unchecked_queues.index_of(queue) >= 0 then
                              unchecked_queues.delete(
                                              unchecked_queues.index_of(queue));
                           end;
                           -- Clean everything up.
                           queue_is_blocked(queue,i,state);
                           return; -- This queue is not to be scanned any further.
                        end;
                        -- Continue scanning the queue.
                     else -- if new_scan_state.dead
                        -- OK, get it. Set the chosen when clause first.
                        thl.ext.clause_write_back.val:=#C_INT(thl.ext.when_clause);
                        get_lock(queue,i,true);
                        -- Is it part of a disjunctive set of requests?
                        if thl.ext.linked_locks.asize > 1 then
                           -- Mark all remaining requests to be obsolete.
                           -- We can't delete them now, because some of them
                           -- might be in the state of beeing processed.
                           mark_other_requests_to_be_obsolete(thl.ext);
                        end;
                     end; -- if new_scan_state.dead
                  end; -- if thl.ext.obsolete
               end; -- if thl.ext.obsolete
               -- *******************  END NEW DEPENDENT ENTRY  **************

            end; -- if SYS::ob_eq(state.tag,thl.ext)
            -- ********************  END DEPENDENT ENTRY  ********************

         end; -- if void(thl.ext)
         -- ************************  MAIN LOOP END  *************************

      end; -- loop i ::= queue.cursor!
      queue.scanned_completely;
      -- This queue is not to be scanned any further.
      if unchecked_queues.index_of(queue) >= 0 then
         unchecked_queues.delete(unchecked_queues.index_of(queue));
      end;
   end; -- private scan_queue(queue:LM_THREAD_HANDLE_QUEUE,state:LM_SCAN_STATE)

   private queue_is_blocked(queue:LM_THREAD_HANDLE_QUEUE,index:INT,
                            state:LM_SCAN_STATE) pre lm_is_locked is
      -- This function is called for cleaning everything up, when an entry
      -- blocks the trailing ones. In this case the scan of the queue will
      -- not reach a seeked entry.
      -- .index is the index of the entry in queue that blocks.

      -- Is any entry to be seeked? If not, return.
      if void(state.queues) then return;
      else
         -- Since this lock cannot be acquired by the seeked entry, it is dead.
         state.dead := true;
         -- Is it not the last entry to be seeked?
         if ~state.queues.is_empty then
            -- It is not the last entry. Continue the search.
            scan_queue(state.queues.remove,state);
            return;
         else -- if ~state.queues.is_empty
            -- We,ve reached the queue of the last entry of this conjunctive
            -- request. The entry has to be between .index and the tail of
            -- the queue. Find it and call get_older on it.
            loop ind ::= queue.ind!(index);
               if SYS::ob_eq(state.tag,queue[ind].ext) then
                  -- This is the last seeked entry.
                  state.blocking := queue[ind].ext.get_older;
               end;
            end;
            return;
         end; -- if ~state.queues.is_empty
      end; -- if void(state.queues)
   end; -- private queue_is_blocked(queue,index,state)

   private mark_other_requests_to_be_obsolete(ext:LM_THREAD_HANDLE_EXTENSION) is
      -- This method is called when one of a set of disjunctive requests
      -- has been acknowledged. Then the other requests of the set are marked
      -- to be obsolete.
      -- Loop over all when clauses.
      loop clause_index ::= ext.linked_locks.ind!;
         -- Only the OTHER requests are obsolete.
         if clause_index /= ext.when_clause then
            -- Since the thread handle extension is shared by all entries
            -- belonging to a (possibly conjunctive) request, it is sufficient
            -- to mark the extension once.
            -- Choose the queue of the first lock of this request.
            queue ::= ext.linked_locks[clause_index][0].queue;
            -- Loop over all entries of the queue.
            loop index ::= queue.ind!;
               -- To check, if it one of the seeked entries we compare the
               -- reference to ext.clause_write_back which is the same for all
               -- disjunctive requests, and the ext.when_clause.
               -- Is this one of the seeked entries?
               if ~void(queue[index].ext) then
                  if SYS::ob_eq(ext.clause_write_back,
                                queue[index].ext.clause_write_back) then
                     if clause_index = queue[index].ext.when_clause then
                        -- Mark the extension to be obsolete.
                        queue[index].ext.mark_obsolete;
                        break!;
                     end; -- if ext.when_clause =
                  end; -- if SYS::ob_eq(
               else                                                 --OUt
               end; -- if ~void(queue[index].ext)
            end; -- loop index ::=
         end; -- if clause_index /=
      end; -- loop clause_index ::=
   end; -- end mark_other_requests_to_be_obsolete(ext)

   private delete_obsolete_request(ext:LM_THREAD_HANDLE_EXTENSION) is
      -- Delete a (possibly conjunctive) request that has been marked
      -- to be obsolete.
      -- Loop over the queues of all locks of this request.
      loop queue ::= ext.linked_locks[ext.when_clause].elt!.queue;
         -- Loop over all entries of the queue.
         loop index ::= queue.ind!;
            -- Is this one of the seeked entries?
            if SYS::ob_eq(ext,queue[index].ext) then
               -- Delete entry.
               queue.delete(index);
               -- Adjust the counter of waiting requests.
               waiting_requests_counter := waiting_requests_counter - 1;
               break!;
            end; -- if
         end; -- loop index ::=
      end; -- loop queue ::=
   end; -- end delete_obsolete_request(ext:LM_THREAD_HANDLE_EXTENSION)

end; -- class LM_COMBINED_LOCKS_MANAGER
