-- The Ada Structured Library - A set of container classes and general
--   tools for use with Ada95.
-- Copyright (C) 1998-1999  Corey Minyard (minyard@acm.org)
--
-- This library is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License 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 the GNU
-- General Public License for more details.
--
-- You should have received a copy of the GNU General Public License along
-- with this library; if not, write to the Free Software Foundation, Inc.,
-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
--
-- As a special exception, if other files instantiate generics from this
-- unit, or you link this unit with other files to produce an executable,
-- this unit does not by itself cause the resulting executable to be
-- covered by the GNU General Public License.  This exception does not
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
--

with Ada.Unchecked_Deallocation;

package body Asgc.Ordered.Dlist.CTYPEMANAGED is

--$START DYNAMIC
   procedure Free_Node is new Ada.Unchecked_Deallocation(Node,
                                                         Node_Ptr);
--$END DYNAMIC

   procedure Free_Iterator is new Ada.Unchecked_Deallocation(Iterator,
                                                             Iterator_Ptr);

--$START EXPANDABLE
   procedure Free_Node_Array is new Ada.Unchecked_Deallocation(Node_Array,
                                                               Node_Array_Ptr);


   ------------------------------------------------------------------------
   -- Increase the size of an expandable list.
   procedure Increase_Data_Size (O : in out Object'Class) is
      New_Array : Node_Array_Ptr;
   begin
      if (O.Increment = 0) then
         raise Container_Full;
      end if;

      New_Array := new Node_Array(1 .. (O.Data.all'Last
                                        + Node_Ref(O.Increment)));
      New_Array(1 .. O.Data.all'Last) := O.Data.all;

      -- Add the elements to the free list.
      for I in O.Data.all'Last + 1 .. New_Array.all'Last loop
         New_Array(I).Next := O.Free_List;
         O.Free_List := I;
      end loop;
      Free_Node_Array(O.Data);
      O.Data := New_Array;
   end Increase_Data_Size;
--$END EXPANDABLE


   ------------------------------------------------------------------------
   -- Allocate a free node for a new item in the list.
   procedure Alloc_Node (O    : in out Object'Class;
                         Item : out REF_VAL) is
   begin
--$START DYNAMIC
      Item := new Node;
--$END DYNAMIC
--$START FIXED
      if (O.Free_List = NULL_REF) then
         raise Container_Full;
      end if;
      Item := O.Free_List;
      O.Free_List := O.Data(Item).Next;
      O.Data(Item).Next := Null_Node;
      O.Data(Item).Prev := Null_Node;
--$END FIXED
--$START EXPANDABLE
      if (O.Free_List = NULL_REF) then
         Increase_Data_Size(O);
      end if;
      Item := O.Free_List;
      O.Free_List := O.Data(Item).Next;
      O.Data(Item).Next := Null_Node;
      O.Data(Item).Prev := Null_Node;
--$END EXPANDABLE
   end Alloc_Node;


   ------------------------------------------------------------------------
   -- Free a node that is no longer in use.
   procedure Free_Node (O    : in out Object'Class;
                        Item : in out REF_VAL) is
   begin
--$START DYNAMIC
      Free_Node(Item);
--$END DYNAMIC
--$START FIXED
      O.Data(Item).Next := O.Free_List;
      O.Free_List := Item;
      Item := Null_Node;
--$END FIXED
--$START EXPANDABLE
      O.Data(Item).Next := O.Free_List;
      O.Free_List := Item;
      Item := Null_Node;
--$END EXPANDABLE
   end Free_Node;


   ------------------------------------------------------------------------
   -- Check that an object is valid, that is has not been freed.  This is
   -- not a perfect check, but will hopefully help find some bugs.
   procedure Check_Object (O : in Object'Class) is
   begin
      if (O.Is_Free) then
         raise Object_Free;
      end if;
   end Check_Object;


   ------------------------------------------------------------------------
   -- Check that an iterator is valid.  It must not have been freed, it
   -- must be initialized, its object must be valid, and it must not have
   -- been modified since the last time the iterator was positioned.
   procedure Check_Iterator (Iter : in Iterator'Class) is
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      if (Iter.Robj = null) then
         raise Invalid_Iterator;
      end if;

      Check_Object(Iter.Robj.all);

      if (Iter.Update /= Iter.Robj.Update) then
         raise Object_Updated;
      end if;

      if (Iter.Pos = NULL_REF) then
         raise Invalid_Iterator;
      end if;
   end Check_Iterator;


   ------------------------------------------------------------------------
   -- Check that an iterator is valid.  It must not have been freed, it
   -- must be initialized, its object must be valid, and it must not have
   -- been modified since the last time the iterator was positioned.
   -- This routine allows the object to be empty.
   procedure Check_Iterator_Empty_Ok (Iter : in Iterator'Class) is
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      if (Iter.Robj = null) then
         raise Invalid_Iterator;
      end if;

      Check_Object(Iter.Robj.all);

      if (Iter.Update /= Iter.Robj.Update) then
         raise Object_Updated;
      end if;
   end Check_Iterator_Empty_Ok;


   ------------------------------------------------------------------------
   -- Check an iterator, but don't bother checking its positions.  This is
   -- primarily for methods that set some the position of the iterator.
   procedure Check_Iterator_No_Pos (Iter : in Iterator) is
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      if (Iter.Robj = null) then
         raise Invalid_Iterator;
      end if;

      Check_Object(Iter.Robj.all);
   end Check_Iterator_No_Pos;


   ------------------------------------------------------------------------
   -- Delete the given reference and free it.
   procedure Delete (O       : in out Object'Class;
                     To_Free : in out REF_VAL;
                     Is_End  : out End_Marker) is
      Next_Val : REF_VAL;
   begin
      Next_Val := REF(O, To_Free).Next;
      if (To_Free /= O.Head) then
         -- Not deleting the first item, modify the prev's next ref.
         REF(O, REF(O, To_Free).Prev).Next := Next_Val;

         if (Next_Val = NULL_REF) then
            -- Deleting the tail, so handle that.
            O.Tail := REF(O, To_Free).Prev;
            Is_End := Past_End;
         else
            REF(O, Next_Val).Prev := REF(O, To_Free).Prev;
            Is_End := Not_Past_End;
         end if;
      else
         -- Deleting the first item, change the head.
         O.Head := Next_Val;
         if (Next_Val = NULL_REF) then
            -- Deleted the only item.
            O.Tail := NULL_REF;
            Is_End := Past_End;
         else
            REF(O, Next_Val).Prev := NULL_REF;
            Is_End := Not_Past_End;
         end if;
      end if;

      O.Update := O.Update + 1;
      O.Count := O.Count - 1;

      if (O.Cb /= null) then
         Deleted(O.Cb, O, REF(O, To_Free).Val);
      end if;

      Free_Node(O, To_Free);
   end Delete;


   ------------------------------------------------------------------------
   -- Add the given item before Curr in the list.
   procedure Add_Before (O    : in out Object'Class;
                         Curr : in REF_VAL;
                         Val  : in Contained_Type) is
      New_Node : REF_VAL;
   begin
      Alloc_Node(O, New_Node);
      REF(O, New_Node).Val := Val;
      if (O.Tail = NULL_REF) then
         -- The list is empty, this becomes the only member.
         O.Head := New_Node;
         O.Tail := New_Node;
      else
         REF(O, New_Node).Next := Curr;
         REF(O, New_Node).Prev := REF(O, Curr).Prev;

         if (O.Head = Curr) then
            -- If we are at the head, the new item becomes the new head.
            O.Head := New_Node;
         else
            REF(O, REF(O, Curr).Prev).Next := New_Node;
         end if;

         REF(O, Curr).Prev := New_Node;
      end if;

      O.Count := O.Count + 1;
      O.Update := O.Update + 1;

      if (O.Cb /= null) then
         Added(O.Cb, O, REF(O, New_Node).Val);
      end if;
   end Add_Before;

   ------------------------------------------------------------------------
   -- Add the given item after Curr in the list.
   procedure Add_After (O    : in out Object'Class;
                        Curr : in REF_VAL;
                        Val  : in Contained_Type) is
      New_Node : REF_VAL;
   begin
      Alloc_Node(O, New_Node);
      REF(O, New_Node).Val := Val;
      if (O.Tail = NULL_REF) then
         -- The list is empty, this becomes the only member.
         O.Head := New_Node;
         O.Tail := New_Node;
      else
         REF(O, New_Node).Next := REF(O, Curr).Next;
         REF(O, New_Node).Prev := Curr;
         REF(O, Curr).Next := New_Node;
         if (O.Tail = Curr) then
            -- If we are at the tail, the new item becomes the new tail.
            O.Tail := New_Node;
         else
            REF(O, REF(O, New_Node).Next).Prev := New_Node;
         end if;
      end if;

      O.Count := O.Count + 1;
      O.Update := O.Update + 1;

      if (O.Cb /= null) then
         Added(O.Cb, O, REF(O, New_Node).Val);
      end if;
   end Add_After;


   ------------------------------------------------------------------------
   -- Using an object and an optional current location, seek to the given
   -- location in the most efficient manner possible.
   function Seek_To (O        : in Object'Class;
                     Loc      : in Positive;
                     Curr     : in REF_VAL     := NULL_REF;
                     Curr_Loc : in Positive    := 1)
                     return REF_VAL is
      Retval       : REF_VAL;
      Diff         : Integer;
      Seek_Forward : Boolean;
   begin
      -- Start with trying the head node.
      Retval := O.Head;
      Diff := Loc - 1;
      Seek_Forward := True;

      if ((O.Count - Loc) < Diff) then
         -- If the tail location is closer to the position, seek from there.
         Diff := O.Count - Loc;
         Seek_Forward := False;
         Retval := O.Tail;
      end if;

      if (Curr /= NULL_REF) then
         -- Now check the passed in location and seek from there if it is
         -- closer.
         if ((Curr_Loc >= Loc) and ((Curr_Loc - Loc) < Diff)) then
            Diff := Curr_Loc - Loc;
            Seek_Forward := False;
            Retval := Curr;
         elsif ((Curr_Loc < Loc) and ((Loc - Curr_Loc) < Diff)) then
            Diff := Loc - Curr_Loc;
            Seek_Forward := True;
            Retval := Curr;
         end if;
      end if;

      -- Now do the seek.
      if (Seek_Forward) then
         for I in 1 .. Diff loop
            Retval := REF(O, Retval).Next;
         end loop;
      else
         for I in 1 .. Diff loop
            Retval := REF(O, Retval).Prev;
         end loop;
      end if;

      return Retval;
   end Seek_To;


   ------------------------------------------------------------------------
   -- This is a controlled type, so we have those methods to handle.


   ------------------------------------------------------------------------
   procedure Initialize (O : in out Object) is
   begin
--$START DYNAMIC
      null;
--$END DYNAMIC
--$START FIXED
      -- Build the free list.
      for I in 1 .. O.Size loop
         O.Data(I).Next := O.Free_List;
         O.Free_List := I;
      end loop;
--$END FIXED
--$START EXPANDABLE
      -- Build the free list.
      for I in 1 .. O.Initial_Size loop
         O.Data(I).Next := O.Free_List;
         O.Free_List := I;
      end loop;
--$END EXPANDABLE
   end Initialize;


   ------------------------------------------------------------------------
   procedure Adjust (O : in out Object) is
      New_List : REF_VAL := NULL_REF;
      New_Curr : REF_VAL;
      Old_Curr : REF_VAL := O.Head;
   begin
--$START DYNAMIC
      if (O.Head = null) then
         O.Head := null;
         O.Tail := null;
      else
         -- Build a whold new list from the current list.
         New_List := new Node;
         New_List.Val := Old_Curr.Val;

         New_Curr := New_List;
         while (Old_Curr.Next /= null) loop
            New_Curr.Next := new Node;
            New_Curr.Next.Prev := New_Curr;
            New_Curr.Next.Val := Old_Curr.Next.Val;
            Old_Curr := Old_Curr.Next;
            New_Curr := New_Curr.Next;
         end loop;
         O.Head := New_List;
         O.Tail := New_Curr;
      end if;
--$END DYNAMIC
--$START EXPANDABLE
      -- Allocate a new data entry.
      O.Data := new Node_Array'(O.Data.all);
--$END EXPANDABLE

      -- Call the Copied callback on each new element if the container has
      -- a callback set.
      if (O.Cb /= null) then
         New_Curr := O.Head;
         while (New_Curr /= NULL_REF) loop
            Copied(O.Cb, O, REF(O, New_Curr).Val);
            New_Curr := REF(O, New_Curr).Next;
         end loop;
      end if;
   end Adjust;


   ------------------------------------------------------------------------
   procedure Finalize (O : in out Object) is
      Curr    : REF_VAL := O.Head;
      Temp    : REF_VAL;
   begin
      while (Curr /= NULL_REF) loop
         if (O.Cb /= null) then
            Deleted(O.Cb, O, REF(O, Curr).Val);
         end if;
         Temp := REF(O, Curr).Next;
--$START DYNAMIC
         Free_Node(Curr);
--$END DYNAMIC
         Curr := Temp;
      end loop;

--$START EXPANDABLE
      Free_Node_Array(O.Data);
--$END EXPANDABLE
      O.Is_Free := True;
   end Finalize;


   ------------------------------------------------------------------------
   procedure Finalize (Iter : in out Iterator) is
   begin
      Iter.Is_Free := True;
   end Finalize;


   ------------------------------------------------------------------------
   -- The functions that follow are defined as abstract in previous
   -- packages.  See those packages for descriptions of what these
   -- methods do.


   ------------------------------------------------------------------------
   function "=" (O1, O2 : in Object) return Boolean is
      Curr1 : REF_VAL;
      Curr2 : REF_VAL;
   begin
      Check_Object(O1);
      Check_Object(O2);

      if (O1.Count /= O2.Count) then
         return False;
      else
         -- Compare all the elements in the lists to see if they are the
         -- same.
         Curr1 := O1.Head;
         Curr2 := O2.Head;
         while (Curr1 /= NULL_REF) loop
            if (Curr2 = NULL_REF) then
               raise Internal_List_Error;
            end if;

            if (REF(O1, Curr1).Val /= REF(O2, Curr2).Val) then
               return False;
            end if;

            Curr1 := REF(O1, Curr1).Next;
            Curr2 := REF(O2, Curr2).Next;
         end loop;

         if (Curr2 /= NULL_REF) then
            raise Internal_List_Error;
         end if;

         return True;
      end if;
   end "=";


   ------------------------------------------------------------------------
   function Member_Count (O : in Object)
                          return Natural is
   begin
      Check_Object(O);

      return O.Count;
   end Member_Count;


   ------------------------------------------------------------------------
   procedure Verify_Integrity (O : in Object) is
      Curr  : REF_VAL;
      Count : Natural;
   begin
      Check_Object(O);

      if (O.Count = 0) then
         if ((O.Head /= NULL_REF) or (O.Tail /= NULL_REF)) then
            raise Internal_List_Error;
         end if;
      else
         Curr := O.Head;
         if (REF(O, Curr).Prev /= NULL_REF) then
            raise Internal_List_Error;
         end if;

         -- Go through all the elemenets and make sure the prev and next
         -- pointers point to each other for each node in the list.
         Count := 1;
         while (REF(O, Curr).Next /= NULL_REF) loop
            if (Count > O.Count) then
               raise Internal_List_Error;
            end if;
            if (REF(O, REF(O, Curr).Next).Prev /= Curr) then
               raise Internal_List_Error;
            end if;
            Curr := REF(O, Curr).Next;
            Count := Count + 1;
         end loop;

         if (Count /= O.Count) then
            raise Internal_List_Error;
         end if;

         if (Curr /= O.Tail) then
            raise Internal_List_Error;
         end if;
      end if;
   end Verify_Integrity;


   ------------------------------------------------------------------------
   function Copy (O : in Object) return Asgc.Object_Class is
      Retval : Object_Ptr;
   begin
--$START DYNAMIC
      Retval := new Object;
--$END DYNAMIC
--$START FIXED
      Retval := new Object(Size => O.Size);
--$END FIXED
--$START EXPANDABLE
      Retval := new Object(Initial_Size => O.Initial_Size,
                           Increment    => O.Increment);
--$END EXPANDABLE
      Retval.all := O;

      return Asgc.Object_Class(Retval);
   end Copy;


   ------------------------------------------------------------------------
   procedure Add_Before (Iter : in out Iterator; Val : in Contained_Type) is
   begin
      Check_Iterator_Empty_Ok(Iter);

      Add_Before(Iter.Robj.all, Iter.Pos, Val);
      if (Iter.Pos = NULL_REF) then
         Iter.Pos := Iter.Robj.Head;
      else
         Iter.Pos := REF(Iter.Robj, Iter.Pos).Prev;
      end if;
      Iter.Update := Iter.Robj.Update;
   end Add_Before;


   ------------------------------------------------------------------------
   procedure Add_After (Iter : in out Iterator; Val : in Contained_Type) is
   begin
      Check_Iterator_Empty_Ok(Iter);

      Add_After(Iter.Robj.all, Iter.Pos, Val);
      if (Iter.Pos = NULL_REF) then
         Iter.Pos := Iter.Robj.Tail;
      else
         Iter.Pos := REF(Iter.Robj, Iter.Pos).Next;
      end if;
      Iter.Offset := Iter.Offset + 1;
      Iter.Update := Iter.Robj.Update;
   end Add_After;


   ------------------------------------------------------------------------
   procedure Delete (O   : in out Object;
                     Val : in Contained_Type) is
      Curr         : REF_VAL;
      Dummy_Is_End : End_Marker;
   begin
      Check_Object(O);

      Curr := O.Head;
      while ((Curr /= NULL_REF) and then(REF(O, Curr).Val /= Val)) loop
         Curr := REF(O, Curr).Next;
      end loop;

      if (Curr /= NULL_REF) then
         Delete(O, Curr, Dummy_Is_End);
      else
         raise Item_Not_Found;
      end if;
   end Delete;


   ------------------------------------------------------------------------
   function Value_Exists (O   : in Object;
                          Val : in Contained_Type)
                          return Boolean is
      Curr         : REF_VAL;
   begin
      Check_Object(O);

      Curr := O.Head;
      while ((Curr /= NULL_REF) and then(REF(O, Curr).Val /= Val)) loop
         Curr := REF(O, Curr).Next;
      end loop;

      return (Curr /= NULL_REF);
   end Value_Exists;


   ------------------------------------------------------------------------
   procedure Add_At (O   : in out Object;
                     Loc : in Positive;
                     Val : in Contained_Type) is
   begin
      Check_Object(O);

      if (Loc > (O.Count + 1)) then
         raise Constraint_Error;
      end if;

      if (Loc = 1) then
         -- Special case for adding the first value.
         Add_Before(O, O.Head, Val);
      else
         Add_After(O, Seek_To(O, Loc - 1), Val);
      end if;
   end Add_At;


   ------------------------------------------------------------------------
   procedure Set_At (O   : in out Object;
                     Loc : in Positive;
                     Val : in Contained_Type) is
      Curr    : REF_VAL;
      Old_Val : Contained_Type;
   begin
      Check_Object(O);

      if (Loc > O.Count) then
         raise Constraint_Error;
      end if;

      Curr := Seek_To(O, Loc);
      Old_Val := REF(O, Curr).Val;
      REF(O, Curr).Val := Val;

      -- Add then delete the values in case these are the same value.  This
      -- can avoid some nasty side effects.
      if (O.Cb /= null) then
         Added(O.Cb, O, REF(O, Curr).Val);
      end if;

      if (O.Cb /= null) then
         Deleted(O.Cb, O, Old_Val);
      end if;
   end Set_At;


   ------------------------------------------------------------------------
   function Get_At (O   : in Object;
                    Loc : in Positive)
                    return Contained_Type is
      Curr : REF_VAL;
   begin
      Check_Object(O);

      if (Loc > O.Count) then
         raise Constraint_Error;
      end if;

      Curr := Seek_To(O, Loc);
      return REF(O, Curr).Val;
   end Get_At;


   ------------------------------------------------------------------------
   procedure Swap_At (O          : in out Object;
                      Loc1, Loc2 : in Positive) is
      Tmp  : Contained_Type;
      Pos1 : REF_VAL;
      Pos2 : REF_VAL;
   begin
      Check_Object(O);

      Pos1 := Seek_To(O, Loc1);
      Pos2 := Seek_To(O, Loc2);

      Tmp := REF(O, Pos1).Val;
      REF(O, Pos1).Val := REF(O, Pos2).Val;
      REF(O, Pos2).Val := Tmp;
   end Swap_At;


   ------------------------------------------------------------------------
   procedure Delete_At (O   : in out Object;
                        Loc : in Positive) is
      To_Delete : REF_VAL;
      Is_End    : End_Marker;
   begin
      Check_Object(O);

      if (Loc > O.Count) then
         raise Constraint_Error;
      end if;

      To_Delete := Seek_To(O, Loc);
      Delete(O, To_Delete, Is_End);
   end Delete_At;


   ------------------------------------------------------------------------
   procedure Push (O   : in out Object;
                   Val : in Contained_Type) is
   begin
      Add_At(O, 1, Val);
   end Push;


   ------------------------------------------------------------------------
   procedure Pop (O   : in out Object;
                  Val : out Contained_Type) is
   begin
      Val := Get_At(O, 1);
      Delete_At(O, 1);
   end Pop;


   ------------------------------------------------------------------------
   procedure Enqueue (O : in out Object; Val : in Contained_Type) is
   begin
      Check_Object(O);

      Add_After(O, O.Tail, Val);
   end Enqueue;


   ------------------------------------------------------------------------
   procedure Dequeue (O   : in out Object;
                      Val : out Contained_Type) is
   begin
      Val := Get_At(O, 1);
      Delete_At(O, 1);
   end Dequeue;


   ------------------------------------------------------------------------
   function New_Iterator (O : access Object) return Asgc.Iterator_Class is
      Retval : Iterator_Ptr;
   begin
      Check_Object(O.all);

      Retval := new Iterator;
      Retval.Robj := Object_Class(O);

      return Asgc.Iterator_Class(Retval);
   end New_Iterator;


   ------------------------------------------------------------------------
   function New_Iterator (O : in Object_class) return Iterator is
      Retval : Iterator;
   begin
      Retval.Robj := O;

      return Retval;
   end New_Iterator;


   ------------------------------------------------------------------------
   procedure Free (Iter : access Iterator) is
      To_Free : Iterator_Ptr := Iterator_Ptr(Iter);
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      Free_Iterator(To_Free);
   end Free;


   ------------------------------------------------------------------------
   procedure Set_Container (Iter : in out Iterator;
                            O    : in Asgc.Object_Class) is
   begin
      Check_Object(Object'Class(O.all));

      Iter.Robj := Object_Class(O);
      Iter.Update := Invalid_Update;
   end Set_Container;


   ------------------------------------------------------------------------
   procedure Set (Iter : in Iterator; Val : in Contained_Type) is
      Old_Val : Contained_Type;
   begin
      Check_Iterator(Iter);

      Old_Val := REF(Iter.Robj, Iter.Pos).Val;
      REF(Iter.Robj, Iter.Pos).Val := Val;

      -- Add then delete the values in case these are the same value.  This
      -- can avoid some nasty side effects.
      if (Iter.Robj.Cb /= null) then
         Added(Iter.Robj.Cb, Iter.Robj.all, REF(Iter.Robj, Iter.Pos).Val);
      end if;

      if (Iter.Robj.Cb /= null) then
         Deleted(Iter.Robj.Cb, Iter.Robj.all, Old_Val);
      end if;
   end Set;


   ------------------------------------------------------------------------
   procedure First (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator_No_Pos(Iter);

      Iter.Pos := Iter.Robj.Head;
      Iter.Update := Iter.Robj.Update;
      if (Iter.Pos = NULL_REF) then
         Is_End := Past_End;
         Iter.Offset := 0;
      else
         Is_End := Not_Past_End;
         Iter.Offset := 1;
      end if;
   end First;


   ------------------------------------------------------------------------
   procedure Next (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);

      if (REF(Iter.Robj, Iter.Pos).Next = NULL_REF) then
         Is_End := Past_End;
      else
         Iter.Pos := REF(Iter.Robj, Iter.Pos).Next;
         Is_End := Not_Past_End;
         Iter.Offset := Iter.Offset + 1;
      end if;
   end Next;


   ------------------------------------------------------------------------
   procedure Delete (Iter : in out Iterator; Is_End : out End_Marker) is
      Local_Is_End : End_Marker;
      Next_Node    : REF_VAL;
   begin
      Check_Iterator(Iter);

      Next_Node := REF(Iter.Robj, Iter.Pos).Next;
      Delete(Iter.Robj.all, Iter.Pos, Local_Is_End);
      if (Local_Is_End = Not_Past_End) then
         Iter.Update := Iter.Robj.Update;
         Iter.Pos := Next_Node;
      end if;
      Is_End := Local_Is_End;
   end Delete;


   ------------------------------------------------------------------------
   function Is_Same (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      if (Iter1.Robj /= Iter2.Robj) then
         raise Iterator_Mismatch;
      end if;

      return (Iter1.Pos = Iter2.Pos);
   end Is_Same;


   ------------------------------------------------------------------------
   function Get (Iter : in Iterator) return Contained_Type is
   begin
      Check_Iterator(Iter);

      return REF(Iter.Robj, Iter.Pos).Val;
   end Get;


   ------------------------------------------------------------------------
   procedure Get_Incr (Iter   : in out Iterator;
                       Val    : out Contained_Type;
                       Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);

      Val := REF(Iter.Robj, Iter.Pos).Val;
      Next(Iter, Is_End);
   end Get_Incr;


   ------------------------------------------------------------------------
   procedure Get_Decr (Iter   : in out Iterator;
                       Val    : out Contained_Type;
                       Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);

      Val := REF(Iter.Robj, Iter.Pos).Val;
      Prev(Iter, Is_End);
   end Get_Decr;


   ------------------------------------------------------------------------
   procedure Last (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator_No_Pos(Iter);

      Iter.Pos := Iter.Robj.Tail;
      Iter.Update := Iter.Robj.Update;
      if (Iter.Pos = NULL_REF) then
         Is_End := Past_End;
         Iter.Offset := 0;
      else
         Is_End := Not_Past_End;
         Iter.Offset := Iter.Robj.Count;
      end if;
   end Last;


   ------------------------------------------------------------------------
   procedure Prev (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);

      if (REF(Iter.Robj, Iter.Pos).Prev = NULL_REF) then
         Is_End := Past_End;
      else
         Iter.Pos := REF(Iter.Robj, Iter.Pos).Prev;
         Is_End := Not_Past_End;
         Iter.Offset := Iter.Offset - 1;
      end if;
   end Prev;


   ------------------------------------------------------------------------
   procedure Set_Loc (Iter : out Iterator; Loc : in Positive) is
   begin
      Check_Iterator_No_Pos(Iter);

      if (Loc > Iter.Robj.Count) then
         raise Constraint_Error;
      end if;

      if ((Iter.Update = Iter.Robj.Update)
          and (Iter.Pos /= NULL_REF))
      then
         -- We have a valid iterator, use it for checking the seek.
         Iter.Pos := Seek_To(Iter.Robj.all, Loc, Iter.Pos, Iter.Offset);
      else
         Iter.Pos := Seek_To(Iter.Robj.all, Loc);
      end if;
      Iter.Offset := Loc;
      Iter.Update := Iter.Robj.Update;
   end Set_Loc;


   ------------------------------------------------------------------------
   function Get_Loc (Iter : in Iterator)
                     return Natural is
   begin
      Check_Iterator_Empty_Ok(Iter);

      return Iter.Offset;
   end Get_Loc;


   ------------------------------------------------------------------------
   function Is_After (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator_Empty_Ok(Iter1);
      Check_Iterator_Empty_Ok(Iter2);

      return (Iter1.Offset > Iter2.Offset);
   end Is_After;


   ------------------------------------------------------------------------
   function Is_Before (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator_Empty_Ok(Iter1);
      Check_Iterator_Empty_Ok(Iter2);

      return (Iter1.Offset < Iter2.Offset);
   end Is_Before;


   ------------------------------------------------------------------------
   function "-" (Iter1, Iter2 : in Iterator) return Integer is
   begin
      Check_Iterator_Empty_Ok(Iter1);
      Check_Iterator_Empty_Ok(Iter2);

      return (Integer(Iter1.Offset) - Integer(Iter2.Offset));
   end "-";


   ------------------------------------------------------------------------
   function "+" (Iter : in Iterator; Offset : in Integer)
                 return Iterator is
      Retval : Iterator;
   begin
      Check_Iterator_Empty_Ok(Iter);

      if ((Offset < 0)
          and then (Iter.Offset <= -Offset))
      then
         raise Constraint_Error;
      elsif ((Offset > 0)
             and then ((Iter.Offset + Offset) > Iter.Robj.Count))
      then
         raise Constraint_Error;
      end if;

      Retval.Robj := Iter.Robj;
      Retval.Offset := Iter.Offset + Offset;
      if (Iter.Offset = 0) then
         Retval.Pos := Seek_To(Iter.Robj.all, Retval.Offset);
      else
         Retval.Pos := Seek_To(Iter.Robj.all,
                               Retval.Offset,
                               Iter.Pos,
                               Iter.Offset);
      end if;

      Retval.Update := Iter.Robj.Update;

      return Retval;
   end "+";


   ------------------------------------------------------------------------
   function "-" (Iter : in Iterator; Offset : in Integer)
                 return Iterator is
   begin
      return (Iter + (- Offset));
   end "-";


   ------------------------------------------------------------------------
   procedure Swap (Iter1, Iter2 : in out Iterator) is
      Temp : Contained_Type;
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      Temp := REF(Iter1.Robj, Iter1.Pos).Val;
      REF(Iter1.Robj, Iter1.Pos).Val := REF(Iter2.Robj, Iter2.Pos).Val;
      REF(Iter2.Robj, Iter2.Pos).Val := Temp;
   end Swap;


   ------------------------------------------------------------------------
   function "=" (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      return (REF(Iter1.Robj, Iter1.Pos).Val = REF(Iter2.Robj, Iter2.Pos).Val);
   end "=";


   ------------------------------------------------------------------------
   function "=" (Iter : in Iterator; Val : in Contained_Type) return Boolean is
   begin
      Check_Iterator(Iter);

      return (REF(Iter.Robj, Iter.Pos).Val = Val);
   end "=";


   ------------------------------------------------------------------------
   function "=" (Val : in Contained_Type; Iter : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter);

      return (Val = REF(Iter.Robj, Iter.Pos).Val);
   end "=";

--$START SORTABLE

   ------------------------------------------------------------------------
   function ">" (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      return (REF(Iter1.Robj, Iter1.Pos).Val > REF(Iter2.Robj, Iter2.Pos).Val);
   end ">";


   ------------------------------------------------------------------------
   function ">" (Iter : in Iterator; Val : in Contained_Type) return Boolean is
   begin
      Check_Iterator(Iter);

      return (REF(Iter.Robj, Iter.Pos).Val > Val);
   end ">";


   ------------------------------------------------------------------------
   function ">" (Val : in Contained_Type; Iter : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter);

      return (Val > REF(Iter.Robj, Iter.Pos).Val);
   end ">";


   ------------------------------------------------------------------------
   function ">=" (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      return (REF(Iter1.Robj, Iter1.Pos).Val
              >= REF(Iter2.Robj, Iter2.Pos).Val);
   end ">=";


   ------------------------------------------------------------------------
   function ">=" (Iter : in Iterator; Val : in Contained_Type)
                  return Boolean is
   begin
      Check_Iterator(Iter);

      return (REF(Iter.Robj, Iter.Pos).Val >= Val);
   end ">=";


   ------------------------------------------------------------------------
   function ">=" (Val : in Contained_Type; Iter : in Iterator)
                  return Boolean is
   begin
      Check_Iterator(Iter);

      return (Val >= REF(Iter.Robj, Iter.Pos).Val);
   end ">=";


   ------------------------------------------------------------------------
   function "<" (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      return (REF(Iter1.Robj, Iter1.Pos).Val < REF(Iter2.Robj, Iter2.Pos).Val);
   end "<";


   ------------------------------------------------------------------------
   function "<" (Iter : in Iterator; Val : in Contained_Type) return Boolean is
   begin
      Check_Iterator(Iter);

      return (REF(Iter.Robj, Iter.Pos).Val < Val);
   end "<";


   ------------------------------------------------------------------------
   function "<" (Val : in Contained_Type; Iter : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter);

      return (Val < REF(Iter.Robj, Iter.Pos).Val);
   end "<";


   ------------------------------------------------------------------------
   function "<=" (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      return (REF(Iter1.Robj, Iter1.Pos).Val
              <= REF(Iter2.Robj, Iter2.Pos).Val);
   end "<=";


   ------------------------------------------------------------------------
   function "<=" (Iter : in Iterator; Val : in Contained_Type)
                  return Boolean is
   begin
      Check_Iterator(Iter);

      return (REF(Iter.Robj, Iter.Pos).Val <= Val);
   end "<=";


   ------------------------------------------------------------------------
   function "<=" (Val : in Contained_Type; Iter : in Iterator)
                  return Boolean is
   begin
      Check_Iterator(Iter);

      return (Val <= REF(Iter.Robj, Iter.Pos).Val);
   end "<=";
--$END SORTABLE

end Asgc.Ordered.Dlist.CTYPEMANAGED;