1. -- 
  2. -- Uwe R. Zimmer, Australia, 2013 
  3. -- 
  4.  
  5. with Queue_Pack_Abstract_Unsync; 
  6.  
  7. generic 
  8.  
  9.    with package Queue_Pack_Abstract_Instantiated is new Queue_Pack_Abstract_Unsync (<>); 
  10.  
  11.    Queue_Size : Positive := 10; 
  12.  
  13. package Queue_Pack_Concrete_Unsync is 
  14.  
  15.    use Queue_Pack_Abstract_Instantiated; 
  16.  
  17.    type Real_Queue is new Queue_Type with private; 
  18.  
  19.    overriding procedure Enqueue (Item :     Element; Queue : in out Real_Queue); 
  20.    overriding procedure Dequeue (Item : out Element; Queue : in out Real_Queue); 
  21.  
  22.    function Is_Empty (Queue : Real_Queue) return Boolean; 
  23.    function Is_Full  (Queue : Real_Queue) return Boolean; 
  24.  
  25.    Queueoverflow, Queueunderflow : exception; 
  26.  
  27. private 
  28.    subtype Marker is Natural range 0 .. Queue_Size - 1; 
  29.    type List is array (Marker) of Element; 
  30.    type Real_Queue is new Queue_Type with record 
  31.       Top, Free : Marker  := Marker'First; 
  32.       Is_Empty  : Boolean := True; 
  33.       Elements  : List; -- 
  34.    end record; 
  35. end Queue_Pack_Concrete_Unsync;