------------------------------------------------------------------------------
--                                                                          --
--                       Copyright (C) 2016, AdaCore                        --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with NRF51_SVD.TWI; use NRF51_SVD.TWI;

package body nRF51.TWI is

   procedure Stop_Sequence (This : in out TWI_Master'Class);

   -------------------
   -- Stop_Sequence --
   -------------------

   procedure Stop_Sequence (This : in out TWI_Master'Class) is
   begin
      --  Stop sequence

      This.Periph.EVENTS_STOPPED := 0;

      This.Periph.TASKS_STOP := 1;

      while This.Periph.EVENTS_STOPPED = 0 loop
         null;
      end loop;
   end Stop_Sequence;

   ------------
   -- Enable --
   ------------

   procedure Enable (This : in out TWI_Master) is
   begin
      This.Periph.ENABLE.ENABLE := Enabled;
   end Enable;

   -------------
   -- Disable --
   -------------

   procedure Disable (This : in out TWI_Master) is
   begin
      This.Periph.ENABLE.ENABLE := Disabled;
   end Disable;

   -------------
   -- Enabled --
   -------------

   function Enabled (This : TWI_Master) return Boolean is
   begin
      return This.Periph.ENABLE.ENABLE = Enabled;
   end Enabled;

   ---------------
   -- Configure --
   ---------------

   procedure Configure
     (This     : in out TWI_Master;
      SCL, SDA : GPIO_Pin_Index;
      Speed    : TWI_Speed)
   is
   begin
      This.Periph.PSELSCL := UInt32 (SCL);
      This.Periph.PSELSDA := UInt32 (SDA);
      This.Periph.FREQUENCY := (case Speed is
                                   when TWI_100kbps => 16#0198_0000#,
                                   when TWI_250kbps => 16#0400_0000#,
                                   when TWI_400kbps => 16#0668_0000#);
   end Configure;

   ----------------
   -- Disconnect --
   ----------------

   procedure Disconnect (This : in out TWI_Master) is
   begin
      This.Periph.PSELSCL := 16#FFFF_FFFF#;
      This.Periph.PSELSDA := 16#FFFF_FFFF#;
   end Disconnect;

   ---------------------
   -- Master_Transmit --
   ---------------------

   overriding procedure Master_Transmit
     (This    : in out TWI_Master;
      Addr    : I2C_Address;
      Data    : I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000)
   is
      pragma Unreferenced (Timeout);
      Index : Integer := Data'First + 1;
   begin
      if Data'Length = 0 then
         Status := Ok;
         return;
      end if;

      --  Clear errors
      This.Periph.ERRORSRC.OVERRUN := Errorsrc_Overrun_Field_Reset;
      This.Periph.ERRORSRC.ANACK   := Errorsrc_Anack_Field_Reset;
      This.Periph.ERRORSRC.DNACK   := Errorsrc_Dnack_Field_Reset;

      --  Set Address
      This.Periph.ADDRESS.ADDRESS := UInt7 (Addr);

      --  Prepare first byte
      This.Periph.TXD.TXD := Data (Data'First);

      --  Start TX sequence
      This.Periph.TASKS_STARTTX := 1;

      loop

         loop

            if This.Periph.EVENTS_ERROR /= 0 then
               Status := Err_Error;
               --  Clear the error
               This.Periph.EVENTS_ERROR := 0;

               --  Stop sequence
               This.Periph.TASKS_STOP := 1;

               return;
            end if;

            exit when This.Periph.EVENTS_TXDSENT /= 0;
         end loop;

         --  Clear the event
         This.Periph.EVENTS_TXDSENT := 0;

         exit when Index > Data'Last;

         This.Periph.TXD.TXD := Data (Index);
         Index := Index + 1;
      end loop;

      if This.Do_Stop_Sequence then
         Stop_Sequence (This);
      end if;

      Status := Ok;
   end Master_Transmit;

   --------------------
   -- Master_Receive --
   --------------------

   overriding procedure Master_Receive
     (This    : in out TWI_Master;
      Addr    : I2C_Address;
      Data    : out I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000)
   is
      pragma Unreferenced (Timeout);
   begin
      if Data'Length = 0 then
         Status := Ok;
         return;
      end if;

      --  Clear errors
      This.Periph.ERRORSRC.OVERRUN := Clear;
      This.Periph.ERRORSRC.ANACK   := Clear;
      This.Periph.ERRORSRC.DNACK   := Clear;

      --  Set Address
      This.Periph.ADDRESS.ADDRESS := UInt7 (Addr);

      --  Configure SHORTS to automatically suspend TWI port when receiving a
      --  byte.
      This.Periph.SHORTS.BB_SUSPEND := Enabled;
      This.Periph.SHORTS.BB_STOP    := Disabled;

      --  Start RX sequence
      This.Periph.TASKS_STARTRX := 1;

      for Index in Data'Range loop

         loop

            if This.Periph.EVENTS_ERROR /= 0 then
               Status := Err_Error;
               --  Clear the error
               This.Periph.EVENTS_ERROR := 0;

               Stop_Sequence (This);

               return;
            end if;

            exit when This.Periph.EVENTS_RXDREADY /= 0;
         end loop;

         if Index = Data'Last and then This.Do_Stop_Sequence then

            --  Configure SHORTS to automatically stop the TWI port and produce
            --  a STOP event on the bus when receiving a byte.
            This.Periph.SHORTS.BB_SUSPEND := Disabled;
            This.Periph.SHORTS.BB_STOP    := Enabled;
         end if;

         --  Clear the event
         This.Periph.EVENTS_RXDREADY := 0;

         Data (Index) := This.Periph.RXD.RXD;
      end loop;

      Status := Ok;
   end Master_Receive;

   ---------------
   -- Mem_Write --
   ---------------

   overriding procedure Mem_Write
     (This          : in out TWI_Master;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000)
   is
   begin

      This.Do_Stop_Sequence := False;

      case Mem_Addr_Size is
         when Memory_Size_8b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (0 => UInt8 (Mem_Addr)),
                                  Status  => Status,
                                  Timeout => Timeout);
         when Memory_Size_16b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (UInt8 (Shift_Right (Mem_Addr, 8)),
                                              UInt8 (Mem_Addr and 16#FF#)),
                                  Status  => Status,
                                  Timeout => Timeout);
      end case;

      This.Do_Stop_Sequence := True;

      if Status /= Ok then
         return;
      end if;

      This.Master_Transmit (Addr    => Addr,
                            Data    => Data,
                            Status  => Status,
                            Timeout => Timeout);
   end Mem_Write;

   --------------
   -- Mem_Read --
   --------------

   overriding procedure Mem_Read
     (This          : in out TWI_Master;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : out I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000)
   is
   begin
      This.Do_Stop_Sequence := False;

      case Mem_Addr_Size is
         when Memory_Size_8b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (0 => UInt8 (Mem_Addr)),
                                  Status  => Status,
                                  Timeout => Timeout);
         when Memory_Size_16b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (UInt8 (Shift_Right (Mem_Addr, 8)),
                                              UInt8 (Mem_Addr and 16#FF#)),
                                  Status  => Status,
                                  Timeout => Timeout);
      end case;

      This.Do_Stop_Sequence := True;

      if Status /= Ok then
         return;
      end if;

      This.Master_Receive (Addr    => Addr,
                           Data    => Data,
                           Status  => Status,
                           Timeout => Timeout);
   end Mem_Read;

end nRF51.TWI;

------------------------------------------------------------------------------
--                                                                          --
--                       Copyright (C) 2016, AdaCore                        --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with NRF51_SVD.TWI; use NRF51_SVD.TWI;

package body nRF51.TWI is

   procedure Stop_Sequence (This : in out TWI_Master'Class);

   -------------------
   -- Stop_Sequence --
   -------------------

   procedure Stop_Sequence (This : in out TWI_Master'Class) is
   begin
      --  Stop sequence

      This.Periph.EVENTS_STOPPED := 0;

      This.Periph.TASKS_STOP := 1;

      while This.Periph.EVENTS_STOPPED = 0 loop
         null;
      end loop;
   end Stop_Sequence;

   ------------
   -- Enable --
   ------------

   procedure Enable (This : in out TWI_Master) is
   begin
      This.Periph.ENABLE.ENABLE := Enabled;
   end Enable;

   -------------
   -- Disable --
   -------------

   procedure Disable (This : in out TWI_Master) is
   begin
      This.Periph.ENABLE.ENABLE := Disabled;
   end Disable;

   -------------
   -- Enabled --
   -------------

   function Enabled (This : TWI_Master) return Boolean is
   begin
      return This.Periph.ENABLE.ENABLE = Enabled;
   end Enabled;

   ---------------
   -- Configure --
   ---------------

   procedure Configure
     (This     : in out TWI_Master;
      SCL, SDA : GPIO_Pin_Index;
      Speed    : TWI_Speed)
   is
   begin
      This.Periph.PSELSCL := UInt32 (SCL);
      This.Periph.PSELSDA := UInt32 (SDA);
      This.Periph.FREQUENCY := (case Speed is
                                   when TWI_100kbps => 16#0198_0000#,
                                   when TWI_250kbps => 16#0400_0000#,
                                   when TWI_400kbps => 16#0668_0000#);
   end Configure;

   ----------------
   -- Disconnect --
   ----------------

   procedure Disconnect (This : in out TWI_Master) is
   begin
      This.Periph.PSELSCL := 16#FFFF_FFFF#;
      This.Periph.PSELSDA := 16#FFFF_FFFF#;
   end Disconnect;

   ---------------------
   -- Master_Transmit --
   ---------------------

   overriding procedure Master_Transmit
     (This    : in out TWI_Master;
      Addr    : I2C_Address;
      Data    : I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000)
   is
      pragma Unreferenced (Timeout);
      Index : Integer := Data'First + 1;
      Evt_Err : UInt32;
      Err_Src : ERRORSRC_Register with Unreferenced;
   begin
      if Data'Length = 0 then
         Status := Ok;
         return;
      end if;

      --  Clear errors
      This.Periph.ERRORSRC.OVERRUN := Errorsrc_Overrun_Field_Reset;
      This.Periph.ERRORSRC.ANACK   := Errorsrc_Anack_Field_Reset;
      This.Periph.ERRORSRC.DNACK   := Errorsrc_Dnack_Field_Reset;

      --  Set Address
      This.Periph.ADDRESS.ADDRESS := UInt7 (Addr / 2);

      --  Prepare first byte
      This.Periph.TXD.TXD := Data (Data'First);

      --  Start TX sequence
      This.Periph.TASKS_STARTTX := 1;

      loop

         loop

            Evt_Err := This.Periph.EVENTS_ERROR;
            if Evt_Err /= 0 then
               Err_Src := This.Periph.ERRORSRC;
               Status := Err_Error;
               --  Clear the error
               This.Periph.EVENTS_ERROR := 0;

               --  Stop sequence
               This.Periph.TASKS_STOP := 1;

               return;
            end if;

            exit when This.Periph.EVENTS_TXDSENT /= 0;
         end loop;

         --  Clear the event
         This.Periph.EVENTS_TXDSENT := 0;

         exit when Index > Data'Last;

         This.Periph.TXD.TXD := Data (Index);
         Index := Index + 1;
      end loop;

      if This.Do_Stop_Sequence then
         Stop_Sequence (This);
      end if;

      Status := Ok;
   end Master_Transmit;

   --------------------
   -- Master_Receive --
   --------------------

   overriding procedure Master_Receive
     (This    : in out TWI_Master;
      Addr    : I2C_Address;
      Data    : out I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000)
   is
      pragma Unreferenced (Timeout);
   begin
      if Data'Length = 0 then
         Status := Ok;
         return;
      end if;

      --  Clear errors
      This.Periph.ERRORSRC.OVERRUN := Clear;
      This.Periph.ERRORSRC.ANACK   := Clear;
      This.Periph.ERRORSRC.DNACK   := Clear;

      --  Set Address
      This.Periph.ADDRESS.ADDRESS := UInt7 (Addr);

      --  Configure SHORTS to automatically suspend TWI port when receiving a
      --  byte.
      This.Periph.SHORTS.BB_SUSPEND := Enabled;
      This.Periph.SHORTS.BB_STOP    := Disabled;

      --  Start RX sequence
      This.Periph.TASKS_STARTRX := 1;

      for Index in Data'Range loop

         loop

            if This.Periph.EVENTS_ERROR /= 0 then
               Status := Err_Error;
               --  Clear the error
               This.Periph.EVENTS_ERROR := 0;

               Stop_Sequence (This);

               return;
            end if;

            exit when This.Periph.EVENTS_RXDREADY /= 0;
         end loop;

         if Index = Data'Last and then This.Do_Stop_Sequence then

            --  Configure SHORTS to automatically stop the TWI port and produce
            --  a STOP event on the bus when receiving a byte.
            This.Periph.SHORTS.BB_SUSPEND := Disabled;
            This.Periph.SHORTS.BB_STOP    := Enabled;
         end if;

         --  Clear the event
         This.Periph.EVENTS_RXDREADY := 0;

         Data (Index) := This.Periph.RXD.RXD;
      end loop;

      Status := Ok;
   end Master_Receive;

   ---------------
   -- Mem_Write --
   ---------------

   overriding procedure Mem_Write
     (This          : in out TWI_Master;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000)
   is
   begin

      This.Do_Stop_Sequence := False;

      case Mem_Addr_Size is
         when Memory_Size_8b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (0 => UInt8 (Mem_Addr)),
                                  Status  => Status,
                                  Timeout => Timeout);
         when Memory_Size_16b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (UInt8 (Shift_Right (Mem_Addr, 8)),
                                              UInt8 (Mem_Addr and 16#FF#)),
                                  Status  => Status,
                                  Timeout => Timeout);
      end case;

      This.Do_Stop_Sequence := True;

      if Status /= Ok then
         return;
      end if;

      This.Master_Transmit (Addr    => Addr,
                            Data    => Data,
                            Status  => Status,
                            Timeout => Timeout);
   end Mem_Write;

   --------------
   -- Mem_Read --
   --------------

   overriding procedure Mem_Read
     (This          : in out TWI_Master;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : out I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000)
   is
   begin
      This.Do_Stop_Sequence := False;

      case Mem_Addr_Size is
         when Memory_Size_8b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (0 => UInt8 (Mem_Addr)),
                                  Status  => Status,
                                  Timeout => Timeout);
         when Memory_Size_16b =>
            This.Master_Transmit (Addr    => Addr,
                                  Data    => (UInt8 (Shift_Right (Mem_Addr, 8)),
                                              UInt8 (Mem_Addr and 16#FF#)),
                                  Status  => Status,
                                  Timeout => Timeout);
      end case;

      This.Do_Stop_Sequence := True;

      if Status /= Ok then
         return;
      end if;

      This.Master_Receive (Addr    => Addr,
                           Data    => Data,
                           Status  => Status,
                           Timeout => Timeout);
   end Mem_Read;

end nRF51.TWI;

Fix I2C address handling

nRF51.TWI: Fix I2C address handling


-----------------------------------------------------------------------
--  mat-interp -- Command interpreter
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Strings;
with Util.Log.Loggers;

with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with Bfd;

with MAT.Types;
with MAT.Readers.Files;
with MAT.Memory.Tools;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Expressions;
with MAT.Frames;
with MAT.Consoles;
package body MAT.Commands is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Commands");

   function Get_Command (Line : in String) return String;
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);
   procedure Frames_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String);
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);

   package Command_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Command_Handler,
                                                Equivalent_Keys => "=",
                                                Hash            => Ada.Strings.Hash);

   Commands : Command_Map.Map;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation);

      Slots : MAT.Memory.Allocation_Map;
      Iter  : MAT.Memory.Allocation_Cursor;

      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation) is
         use type MAT.Frames.Frame_Type;
         Backtrace : constant MAT.Frames.Frame_Table := MAT.Frames.Backtrace (Slot.Frame);

         Name : Ada.Strings.Unbounded.Unbounded_String;
         Func : Ada.Strings.Unbounded.Unbounded_String;
         Line : Natural;
      begin
         Ada.Text_IO.Put (MAT.Types.Hex_Image (Addr));
         Ada.Text_IO.Set_Col (14);
         Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Slot.Size));
         Ada.Text_IO.Set_Col (30);
         Ada.Text_IO.Put (MAT.Types.Target_Thread_Ref'Image (Slot.Thread));
         Ada.Text_IO.Set_Col (50);
         Ada.Text_IO.Put (MAT.Types.Target_Tick_Ref'Image (Slot.Time));
         Ada.Text_IO.New_Line;
         for I in Backtrace'Range loop
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Natural'Image (I));
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (MAT.Types.Hex_Image (Backtrace (I)));
            MAT.Symbols.Targets.Find_Nearest_Line (Symbols => Target.Symbols,
                                                   Addr    => Backtrace (I),
                                                   Name    => Name,
                                                   Func    => Func,
                                                   Line    => Line);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Func));
            Ada.Text_IO.Put (" ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Name));
            if Line /= 0 then
               Ada.Text_IO.Put (":");
               Ada.Text_IO.Put (Util.Strings.Image (Line));
            end if;
            Ada.Text_IO.New_Line;
         end loop;
      end Print;

      Filter : MAT.Expressions.Expression_Type;
   begin
      Filter := MAT.Expressions.Parse (Args);
      Target.Memory.Find (From   => MAT.Types.Target_Addr'First,
                          To     => MAT.Types.Target_Addr'Last,
                          Filter => Filter,
                          Into   => Slots);
      Iter := Slots.First;
      while MAT.Memory.Allocation_Maps.Has_Element (Iter) loop
         MAT.Memory.Allocation_Maps.Query_Element (Iter, Print'Access);
         MAT.Memory.Allocation_Maps.Next (Iter);
      end loop;

   exception
      when E : others =>
         Log.Error ("Exception when evaluating " & Args, E);
         Target.Console.Error ("Invalid selection");
   end Slot_Command;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String) is
      pragma Unreferenced (Args);

      Sizes   : MAT.Memory.Tools.Size_Info_Map;
      Iter    : MAT.Memory.Tools.Size_Info_Cursor;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
   begin
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_SIZE, "Slot size", 25);
      Console.Print_Title (MAT.Consoles.F_COUNT, "Count", 15);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.End_Title;

      MAT.Memory.Targets.Size_Information (Memory => Target.Memory,
                                           Sizes  => Sizes);
      Iter := Sizes.First;
      while MAT.Memory.Tools.Size_Info_Maps.Has_Element (Iter) loop
         declare
            use MAT.Memory.Tools;
            use type MAT.Types.Target_Size;

            Size  : constant MAT.Types.Target_Size := MAT.Memory.Tools.Size_Info_Maps.Key (Iter);
            Info  : constant Size_Info_Type := Memory.Tools.Size_Info_Maps.Element (Iter);
            Total : constant MAT.Types.Target_Size := Size * MAT.Types.Target_Size (Info.Count);
         begin
            Console.Start_Row;
            Console.Print_Size (MAT.Consoles.F_SIZE, Size);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Count);
            Console.Print_Field (MAT.Consoles.F_TOTAL_SIZE, Total);
            Console.End_Row;
         end;
         MAT.Memory.Tools.Size_Info_Maps.Next (Iter);
      end loop;
   end Sizes_Command;

   --  ------------------------------
   --  Threads command.
   --  Collect statistics about the threads and their allocation.
   --  ------------------------------
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String) is
      pragma Unreferenced (Args);

      Threads : MAT.Memory.Memory_Info_Map;
      Iter    : MAT.Memory.Memory_Info_Cursor;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
   begin
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_THREAD, "Thread", 10);
      Console.Print_Title (MAT.Consoles.F_COUNT, "# Allocation", 12);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_SIZE, "Min slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_SIZE, "Max slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_ADDR, "Low address", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_ADDR, "High address", 15);
      Console.End_Title;

      MAT.Memory.Targets.Thread_Information (Memory  => Target.Memory,
                                             Threads => Threads);
      Iter := Threads.First;
      while MAT.Memory.Memory_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Thread : constant Types.Target_Thread_Ref := MAT.Memory.Memory_Info_Maps.Key (Iter);
            Info   : constant Memory.Memory_Info := MAT.Memory.Memory_Info_Maps.Element (Iter);
         begin
            Console.Start_Row;
            Console.Print_Thread (MAT.Consoles.F_THREAD, Thread);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Alloc_Count);
            Console.Print_Size (MAT.Consoles.F_TOTAL_SIZE, Info.Total_Size);
            Console.Print_Size (MAT.Consoles.F_MIN_SIZE, Info.Min_Slot_Size);
            Console.Print_Size (MAT.Consoles.F_MAX_SIZE, Info.Max_Slot_Size);
            Console.Print_Field (MAT.Consoles.F_MIN_ADDR, Info.Min_Addr);
            Console.Print_Field (MAT.Consoles.F_MAX_ADDR, Info.Max_Addr);
            Console.End_Row;
         end;
         MAT.Memory.Memory_Info_Maps.Next (Iter);
      end loop;
   end Threads_Command;

   --  ------------------------------
   --  Frames command.
   --  Collect statistics about the frames and their allocation.
   --  ------------------------------
   procedure Frames_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
      Frames  : MAT.Memory.Frame_Info_Map;
      Iter    : MAT.Memory.Frame_Info_Cursor;
      Level   : Positive := 3;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
   begin
      if Args'Length > 0 then
         Level := Positive'Value (Args);
      end if;
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_FILE_NAME, "File", 20);
      Console.Print_Title (MAT.Consoles.F_FUNCTION_NAME, "Function", 20);
      Console.Print_Title (MAT.Consoles.F_LINE_NUMBER, "Line", 6);
      Console.Print_Title (MAT.Consoles.F_COUNT, "# Allocation", 12);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_SIZE, "Min slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_SIZE, "Max slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_ADDR, "Low address", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_ADDR, "High address", 15);
      Console.End_Title;

      MAT.Memory.Targets.Frame_Information (Memory => Target.Memory,
                                            Level  => Level,
                                            Frames => Frames);
      Iter := Frames.First;
      while MAT.Memory.Frame_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Func   : constant Types.Target_Addr := MAT.Memory.Frame_Info_Maps.Key (Iter);
            Info   : constant Memory.Frame_Info := MAT.Memory.Frame_Info_Maps.Element (Iter);
            Name : Ada.Strings.Unbounded.Unbounded_String;
            File_Name : Ada.Strings.Unbounded.Unbounded_String;
            Line : Natural;
         begin
            MAT.Symbols.Targets.Find_Nearest_Line (Symbols => Target.Symbols,
                                                   Addr    => Func,
                                                   Name    => Name,
                                                   Func    => File_Name,
                                                   Line    => Line);
            Console.Start_Row;
            Console.Print_Field (MAT.Consoles.F_FILE_NAME, File_Name);
            Console.Print_Field (MAT.Consoles.F_FUNCTION_NAME, Name);
            Console.Print_Field (MAT.Consoles.F_LINE_NUMBER, Line);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Memory.Alloc_Count);
            Console.Print_Size (MAT.Consoles.F_TOTAL_SIZE, Info.Memory.Total_Size);
            Console.Print_Size (MAT.Consoles.F_MIN_SIZE, Info.Memory.Min_Slot_Size);
            Console.Print_Size (MAT.Consoles.F_MAX_SIZE, Info.Memory.Max_Slot_Size);
            Console.Print_Field (MAT.Consoles.F_MIN_ADDR, Info.Memory.Min_Addr);
            Console.Print_Field (MAT.Consoles.F_MAX_ADDR, Info.Memory.Max_Addr);
            Console.End_Row;
         end;
         MAT.Memory.Frame_Info_Maps.Next (Iter);
      end loop;
   end Frames_Command;

   --  ------------------------------
   --  Symbol command.
   --  Load the symbols from the binary file.
   --  ------------------------------
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
   begin
      MAT.Symbols.Targets.Open (Target.Symbols, Args);

   exception
      when Bfd.OPEN_ERROR =>
         Target.Console.Error ("Cannot open symbol file '" & Args & "'");
   end Symbol_Command;

   --  ------------------------------
   --  Exit command.
   --  ------------------------------
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
   begin
      raise Stop_Interp;
   end Exit_Command;

   --  ------------------------------
   --  Open a MAT file and read the events.
   --  ------------------------------
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Reader : MAT.Readers.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Args);
      Reader.Read_All;

   exception
      when E : Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot open {0}: {1}", Args, Ada.Exceptions.Exception_Message (E));
   end Open_Command;

   function Get_Command (Line : in String) return String is
      Pos : constant Natural := Util.Strings.Index (Line, ' ');
   begin
      if Pos = 0 then
         return Line;
      else
         return Line (Line'First .. Pos - 1);
      end if;
   end Get_Command;

   --  ------------------------------
   --  Execute the command given in the line.
   --  ------------------------------
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String) is
      Command : constant String := Get_Command (Line);
      Index   : constant Natural := Util.Strings.Index (Line, ' ');
      Pos     : constant Command_Map.Cursor := Commands.Find (Command);
   begin
      if Command_Map.Has_Element (Pos) then
         Command_Map.Element (Pos) (Target, Line (Index + 1 .. Line'Last));
      elsif Command'Length > 0 then
         Target.Console.Error ("Command '" & Command & "' not found");
      end if;

   exception
      when Stop_Interp =>
         raise;

      when E : others =>
         Log.Error ("Exception: ", E);
         Target.Console.Error ("Exception while processing command");

   end Execute;

begin
   Commands.Insert ("exit", Exit_Command'Access);
   Commands.Insert ("quit", Exit_Command'Access);
   Commands.Insert ("open", Open_Command'Access);
   Commands.Insert ("sizes", Sizes_Command'Access);
   Commands.Insert ("symbol", Symbol_Command'Access);
   Commands.Insert ("slots", Slot_Command'Access);
   Commands.Insert ("threads", Threads_Command'Access);
   Commands.Insert ("frames", Frames_Command'Access);
end MAT.Commands;

-----------------------------------------------------------------------
--  mat-interp -- Command interpreter
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Strings;
with Util.Log.Loggers;

with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with Bfd;

with MAT.Types;
with MAT.Readers.Files;
with MAT.Memory.Tools;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Expressions;
with MAT.Frames;
with MAT.Consoles;
package body MAT.Commands is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Commands");

   function Get_Command (Line : in String) return String;
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);
   procedure Frames_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String);
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);

   package Command_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Command_Handler,
                                                Equivalent_Keys => "=",
                                                Hash            => Ada.Strings.Hash);

   Commands : Command_Map.Map;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation);

      Slots : MAT.Memory.Allocation_Map;
      Iter  : MAT.Memory.Allocation_Cursor;

      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation) is
         use type MAT.Frames.Frame_Type;
         Backtrace : constant MAT.Frames.Frame_Table := MAT.Frames.Backtrace (Slot.Frame);

         Name : Ada.Strings.Unbounded.Unbounded_String;
         Func : Ada.Strings.Unbounded.Unbounded_String;
         Line : Natural;
      begin
         Ada.Text_IO.Put (MAT.Types.Hex_Image (Addr));
         Ada.Text_IO.Set_Col (14);
         Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Slot.Size));
         Ada.Text_IO.Set_Col (30);
         Ada.Text_IO.Put (MAT.Types.Target_Thread_Ref'Image (Slot.Thread));
         Ada.Text_IO.Set_Col (50);
         Ada.Text_IO.Put (MAT.Types.Target_Tick_Ref'Image (Slot.Time));
         Ada.Text_IO.New_Line;
         for I in Backtrace'Range loop
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Natural'Image (I));
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (MAT.Types.Hex_Image (Backtrace (I)));
            MAT.Symbols.Targets.Find_Nearest_Line (Symbols => Target.Symbols,
                                                   Addr    => Backtrace (I),
                                                   Name    => Name,
                                                   Func    => Func,
                                                   Line    => Line);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Func));
            Ada.Text_IO.Put (" ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Name));
            if Line /= 0 then
               Ada.Text_IO.Put (":");
               Ada.Text_IO.Put (Util.Strings.Image (Line));
            end if;
            Ada.Text_IO.New_Line;
         end loop;
      end Print;

      Filter : MAT.Expressions.Expression_Type;
      Process : constant MAT.Targets.Target_Process_Type_Access := Target.Process;
   begin
      Filter := MAT.Expressions.Parse (Args);
      Process.Memory.Find (From   => MAT.Types.Target_Addr'First,
                           To     => MAT.Types.Target_Addr'Last,
                           Filter => Filter,
                           Into   => Slots);
      Iter := Slots.First;
      while MAT.Memory.Allocation_Maps.Has_Element (Iter) loop
         MAT.Memory.Allocation_Maps.Query_Element (Iter, Print'Access);
         MAT.Memory.Allocation_Maps.Next (Iter);
      end loop;

   exception
      when E : others =>
         Log.Error ("Exception when evaluating " & Args, E);
         Target.Console.Error ("Invalid selection");
   end Slot_Command;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String) is
      pragma Unreferenced (Args);

      Sizes   : MAT.Memory.Tools.Size_Info_Map;
      Iter    : MAT.Memory.Tools.Size_Info_Cursor;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
      Process : constant MAT.Targets.Target_Process_Type_Access := Target.Process;
   begin
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_SIZE, "Slot size", 25);
      Console.Print_Title (MAT.Consoles.F_COUNT, "Count", 15);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.End_Title;

      MAT.Memory.Targets.Size_Information (Memory => Process.Memory,
                                           Sizes  => Sizes);
      Iter := Sizes.First;
      while MAT.Memory.Tools.Size_Info_Maps.Has_Element (Iter) loop
         declare
            use MAT.Memory.Tools;
            use type MAT.Types.Target_Size;

            Size  : constant MAT.Types.Target_Size := MAT.Memory.Tools.Size_Info_Maps.Key (Iter);
            Info  : constant Size_Info_Type := Memory.Tools.Size_Info_Maps.Element (Iter);
            Total : constant MAT.Types.Target_Size := Size * MAT.Types.Target_Size (Info.Count);
         begin
            Console.Start_Row;
            Console.Print_Size (MAT.Consoles.F_SIZE, Size);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Count);
            Console.Print_Field (MAT.Consoles.F_TOTAL_SIZE, Total);
            Console.End_Row;
         end;
         MAT.Memory.Tools.Size_Info_Maps.Next (Iter);
      end loop;
   end Sizes_Command;

   --  ------------------------------
   --  Threads command.
   --  Collect statistics about the threads and their allocation.
   --  ------------------------------
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String) is
      pragma Unreferenced (Args);

      Threads : MAT.Memory.Memory_Info_Map;
      Iter    : MAT.Memory.Memory_Info_Cursor;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
      Process : constant MAT.Targets.Target_Process_Type_Access := Target.Process;
   begin
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_THREAD, "Thread", 10);
      Console.Print_Title (MAT.Consoles.F_COUNT, "# Allocation", 12);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_SIZE, "Min slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_SIZE, "Max slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_ADDR, "Low address", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_ADDR, "High address", 15);
      Console.End_Title;

      MAT.Memory.Targets.Thread_Information (Memory  => Process.Memory,
                                             Threads => Threads);
      Iter := Threads.First;
      while MAT.Memory.Memory_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Thread : constant Types.Target_Thread_Ref := MAT.Memory.Memory_Info_Maps.Key (Iter);
            Info   : constant Memory.Memory_Info := MAT.Memory.Memory_Info_Maps.Element (Iter);
         begin
            Console.Start_Row;
            Console.Print_Thread (MAT.Consoles.F_THREAD, Thread);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Alloc_Count);
            Console.Print_Size (MAT.Consoles.F_TOTAL_SIZE, Info.Total_Size);
            Console.Print_Size (MAT.Consoles.F_MIN_SIZE, Info.Min_Slot_Size);
            Console.Print_Size (MAT.Consoles.F_MAX_SIZE, Info.Max_Slot_Size);
            Console.Print_Field (MAT.Consoles.F_MIN_ADDR, Info.Min_Addr);
            Console.Print_Field (MAT.Consoles.F_MAX_ADDR, Info.Max_Addr);
            Console.End_Row;
         end;
         MAT.Memory.Memory_Info_Maps.Next (Iter);
      end loop;
   end Threads_Command;

   --  ------------------------------
   --  Frames command.
   --  Collect statistics about the frames and their allocation.
   --  ------------------------------
   procedure Frames_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
      Frames  : MAT.Memory.Frame_Info_Map;
      Iter    : MAT.Memory.Frame_Info_Cursor;
      Level   : Positive := 3;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
      Process : constant MAT.Targets.Target_Process_Type_Access := Target.Process;
   begin
      if Args'Length > 0 then
         Level := Positive'Value (Args);
      end if;
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_FILE_NAME, "File", 20);
      Console.Print_Title (MAT.Consoles.F_FUNCTION_NAME, "Function", 20);
      Console.Print_Title (MAT.Consoles.F_LINE_NUMBER, "Line", 6);
      Console.Print_Title (MAT.Consoles.F_COUNT, "# Allocation", 12);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_SIZE, "Min slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_SIZE, "Max slot size", 15);
      Console.Print_Title (MAT.Consoles.F_MIN_ADDR, "Low address", 15);
      Console.Print_Title (MAT.Consoles.F_MAX_ADDR, "High address", 15);
      Console.End_Title;

      MAT.Memory.Targets.Frame_Information (Memory => Process.Memory,
                                            Level  => Level,
                                            Frames => Frames);
      Iter := Frames.First;
      while MAT.Memory.Frame_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Func   : constant Types.Target_Addr := MAT.Memory.Frame_Info_Maps.Key (Iter);
            Info   : constant Memory.Frame_Info := MAT.Memory.Frame_Info_Maps.Element (Iter);
            Name : Ada.Strings.Unbounded.Unbounded_String;
            File_Name : Ada.Strings.Unbounded.Unbounded_String;
            Line : Natural;
         begin
            MAT.Symbols.Targets.Find_Nearest_Line (Symbols => Target.Symbols,
                                                   Addr    => Func,
                                                   Name    => Name,
                                                   Func    => File_Name,
                                                   Line    => Line);
            Console.Start_Row;
            Console.Print_Field (MAT.Consoles.F_FILE_NAME, File_Name);
            Console.Print_Field (MAT.Consoles.F_FUNCTION_NAME, Name);
            Console.Print_Field (MAT.Consoles.F_LINE_NUMBER, Line);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Memory.Alloc_Count);
            Console.Print_Size (MAT.Consoles.F_TOTAL_SIZE, Info.Memory.Total_Size);
            Console.Print_Size (MAT.Consoles.F_MIN_SIZE, Info.Memory.Min_Slot_Size);
            Console.Print_Size (MAT.Consoles.F_MAX_SIZE, Info.Memory.Max_Slot_Size);
            Console.Print_Field (MAT.Consoles.F_MIN_ADDR, Info.Memory.Min_Addr);
            Console.Print_Field (MAT.Consoles.F_MAX_ADDR, Info.Memory.Max_Addr);
            Console.End_Row;
         end;
         MAT.Memory.Frame_Info_Maps.Next (Iter);
      end loop;
   end Frames_Command;

   --  ------------------------------
   --  Symbol command.
   --  Load the symbols from the binary file.
   --  ------------------------------
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
   begin
      MAT.Symbols.Targets.Open (Target.Symbols, Args);

   exception
      when Bfd.OPEN_ERROR =>
         Target.Console.Error ("Cannot open symbol file '" & Args & "'");
   end Symbol_Command;

   --  ------------------------------
   --  Exit command.
   --  ------------------------------
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
   begin
      raise Stop_Interp;
   end Exit_Command;

   --  ------------------------------
   --  Open a MAT file and read the events.
   --  ------------------------------
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Reader : MAT.Readers.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Args);
      Reader.Read_All;

   exception
      when E : Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot open {0}: {1}", Args, Ada.Exceptions.Exception_Message (E));
   end Open_Command;

   function Get_Command (Line : in String) return String is
      Pos : constant Natural := Util.Strings.Index (Line, ' ');
   begin
      if Pos = 0 then
         return Line;
      else
         return Line (Line'First .. Pos - 1);
      end if;
   end Get_Command;

   --  ------------------------------
   --  Execute the command given in the line.
   --  ------------------------------
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String) is
      Command : constant String := Get_Command (Line);
      Index   : constant Natural := Util.Strings.Index (Line, ' ');
      Pos     : constant Command_Map.Cursor := Commands.Find (Command);
   begin
      if Command_Map.Has_Element (Pos) then
         Command_Map.Element (Pos) (Target, Line (Index + 1 .. Line'Last));
      elsif Command'Length > 0 then
         Target.Console.Error ("Command '" & Command & "' not found");
      end if;

   exception
      when Stop_Interp =>
         raise;

      when E : others =>
         Log.Error ("Exception: ", E);
         Target.Console.Error ("Exception while processing command");

   end Execute;

begin
   Commands.Insert ("exit", Exit_Command'Access);
   Commands.Insert ("quit", Exit_Command'Access);
   Commands.Insert ("open", Open_Command'Access);
   Commands.Insert ("sizes", Sizes_Command'Access);
   Commands.Insert ("symbol", Symbol_Command'Access);
   Commands.Insert ("slots", Slot_Command'Access);
   Commands.Insert ("threads", Threads_Command'Access);
   Commands.Insert ("frames", Frames_Command'Access);
end MAT.Commands;

Use the Process function to get the target process instance


-----------------------------------------------------------------------
--  mat-consoles - Console interface
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body MAT.Consoles is

   --  ------------------------------
   --  Format the address and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr) is
      Value : constant String := MAT.Types.Hex_Image (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

   --  ------------------------------
   --  Format the size and print it for the given field.
   --  ------------------------------
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size) is
      Value : constant String := MAT.Types.Target_Size'Image (Size);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Size;

   --  ------------------------------
   --  Format the integer and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer) is
      Val : constant String := Integer'Image (Value);
   begin
      Console_Type'Class (Console).Print_Field (Field, Val);
   end Print_Field;

end MAT.Consoles;

-----------------------------------------------------------------------
--  mat-consoles - Console interface
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body MAT.Consoles is

   --  ------------------------------
   --  Print the title for the given field and setup the associated field size.
   --  ------------------------------
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive) is
   begin
      Console.Sizes (Field) := Length;
      Console.Field_Count := Console.Field_Count + 1;
      Console.Fields (Console.Field_Count) := Field;
      Console_Type'Class (Console).Print_Title (Field, Title);
   end Print_Title;

   --  ------------------------------
   --  Format the address and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr) is
      Value : constant String := MAT.Types.Hex_Image (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

   --  ------------------------------
   --  Format the size and print it for the given field.
   --  ------------------------------
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size) is
      Value : constant String := MAT.Types.Target_Size'Image (Size);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Size;

   --  ------------------------------
   --  Format the integer and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer) is
      Val : constant String := Integer'Image (Value);
   begin
      Console_Type'Class (Console).Print_Field (Field, Val);
   end Print_Field;

end MAT.Consoles;

Implement the Print_Title procedure to keep track of column sizes


-----------------------------------------------------------------------
--  util-streams-buffered -- Buffered streams utilities
--  Copyright (C) 2010, 2011, 2013, 2014, 2016, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;
package body Util.Streams.Buffered is

   procedure Free_Buffer is
     new Ada.Unchecked_Deallocation (Object => Stream_Element_Array,
                                     Name   => Buffer_Access);

   --  ------------------------------
   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Positive) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Size);
      Stream.Buffer    := new Stream_Element_Array (1 .. Stream.Last);
      Stream.Output    := Output;
      Stream.Write_Pos := 1;
      Stream.Read_Pos  := 1;
      Stream.No_Flush  := False;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream to read from the string.
   --  ------------------------------
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Content : in String) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Content'Length);
      Stream.Buffer    := new Stream_Element_Array (1 .. Content'Length);
      Stream.Input     := null;
      Stream.Write_Pos := Stream.Last + 1;
      Stream.Read_Pos  := 1;
      for I in Content'Range loop
         Stream.Buffer (Stream_Element_Offset (I - Content'First + 1))
           := Character'Pos (Content (I));
      end loop;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream with a buffer of Size bytes.
   --  ------------------------------
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Size    : in Positive) is
   begin
      Stream.Initialize (Output => null, Size => Size);
      Stream.No_Flush := True;
      Stream.Read_Pos := 1;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Size);
      Stream.Buffer    := new Stream_Element_Array (1 .. Stream.Last);
      Stream.Input     := Input;
      Stream.Write_Pos := 1;
      Stream.Read_Pos  := 1;
   end Initialize;

   --  ------------------------------
   --  Close the sink.
   --  ------------------------------
   overriding
   procedure Close (Stream : in out Output_Buffer_Stream) is
   begin
      if Stream.Output /= null then
         Output_Buffer_Stream'Class (Stream).Flush;
         Stream.Output.Close;
      end if;
   end Close;

   --  ------------------------------
   --  Get the direct access to the buffer.
   --  ------------------------------
   function Get_Buffer (Stream : in Output_Buffer_Stream) return Buffer_Access is
   begin
      return Stream.Buffer;
   end Get_Buffer;

   --  ------------------------------
   --  Get the number of element in the stream.
   --  ------------------------------
   function Get_Size (Stream : in Output_Buffer_Stream) return Natural is
   begin
      return Natural (Stream.Write_Pos - Stream.Read_Pos);
   end Get_Size;

   --  ------------------------------
   --  Write the buffer array to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out Output_Buffer_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Start : Stream_Element_Offset := Buffer'First;
      Pos   : Stream_Element_Offset := Stream.Write_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
   begin
      while Start <= Buffer'Last loop
         Size := Buffer'Last - Start + 1;
         Avail := Stream.Last - Pos + 1;
         if Avail = 0 then
            if Stream.Output = null then
               raise Ada.IO_Exceptions.End_Error with "Buffer is full";
            end if;
            Stream.Output.Write (Stream.Buffer (1 .. Pos - 1));
            Stream.Write_Pos := 1;
            Pos := 1;
            Avail := Stream.Last - Pos + 1;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Stream.Buffer (Pos .. Pos + Size - 1) := Buffer (Start .. Start + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Stream.Write_Pos := Pos;

         --  If we have still more data than the buffer size, flush and write
         --  the buffer directly.
         if Start < Buffer'Last and then Buffer'Last - Start > Stream.Buffer'Length then
            if Stream.Output = null then
               raise Ada.IO_Exceptions.End_Error with "Buffer is full";
            end if;
            Stream.Output.Write (Stream.Buffer (1 .. Pos - 1));
            Stream.Write_Pos := 1;
            Stream.Output.Write (Buffer (Start .. Buffer'Last));
            return;
         end if;
      end loop;
   end Write;

   --  ------------------------------
   --  Flush the stream.
   --  ------------------------------
   overriding
   procedure Flush (Stream : in out Output_Buffer_Stream) is
   begin
      if Stream.Write_Pos > 1 and not Stream.No_Flush then
         if Stream.Output /= null then
            Stream.Output.Write (Stream.Buffer (1 .. Stream.Write_Pos - 1));
            Stream.Output.Flush;
         end if;
         Stream.Write_Pos := 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Flush the buffer in the <tt>Into</tt> array and return the index of the
   --  last element (inclusive) in <tt>Last</tt>.
   --  ------------------------------
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Streams.Stream_Element_Array;
                    Last   : out Ada.Streams.Stream_Element_Offset) is
   begin
      if Stream.Write_Pos > 1 then
         Into (Into'First .. Into'First + Stream.Write_Pos - 1) :=
           Stream.Buffer (Stream.Buffer'First .. Stream.Write_Pos - 1);
         Stream.Write_Pos := 1;
         Last := Into'First + Stream.Write_Pos - 1;
      else
         Last := Into'First - 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Flush the buffer stream to the unbounded string.
   --  ------------------------------
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Ada.Strings.Unbounded.Set_Unbounded_String (Into, "");
      if Stream.Write_Pos > 1 then
         for I in 1 .. Stream.Write_Pos - 1 loop
            Ada.Strings.Unbounded.Append (Into, Character'Val (Stream.Buffer (I)));
         end loop;
         Stream.Write_Pos := 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   --  ------------------------------
   procedure Fill (Stream : in out Input_Buffer_Stream) is
   begin
      if Stream.Input = null then
         Stream.Eof := True;
      else
         Stream.Input.Read (Stream.Buffer (1 .. Stream.Last - 1), Stream.Write_Pos);
         Stream.Eof := Stream.Write_Pos < 1;
         if not Stream.Eof then
            Stream.Write_Pos := Stream.Write_Pos + 1;
         end if;
         Stream.Read_Pos := 1;
      end if;
   end Fill;

   --  ------------------------------
   --  Read one character from the input stream.
   --  ------------------------------
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Char   : out Character) is
   begin
      if Stream.Read_Pos >= Stream.Write_Pos then
         Stream.Fill;
         if Stream.Eof then
            raise Ada.IO_Exceptions.Data_Error with "End of buffer";
         end if;
      end if;
      Char := Character'Val (Stream.Buffer (Stream.Read_Pos));
      Stream.Read_Pos := Stream.Read_Pos + 1;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Start : Stream_Element_Offset := Into'First;
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
      Total : Stream_Element_Offset := 0;
   begin
      while Start <= Into'Last loop
         Size := Into'Last - Start + 1;
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            Pos := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
            exit when Avail <= 0;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Into (Start .. Start + Size - 1) := Stream.Buffer (Pos .. Pos + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Total := Total + Size;
         Stream.Read_Pos := Pos;
      end loop;
      Last := Total;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String) is
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
   begin
      loop
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            if Stream.Eof then
               return;
            end if;
            Pos   := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
         end if;
         for I in 1 .. Avail loop
            Ada.Strings.Unbounded.Append (Into, Character'Val (Stream.Buffer (Pos)));
            Pos := Pos + 1;
         end loop;
         Stream.Read_Pos := Pos;
      end loop;
   end Read;

   --  ------------------------------
   --  Flush the stream and release the buffer.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Output_Buffer_Stream) is
   begin
      if Object.Buffer /= null then
         if Object.Output /= null then
            Object.Flush;
         end if;
         Free_Buffer (Object.Buffer);
      end if;
   end Finalize;

   --  ------------------------------
   --  Returns True if the end of the stream is reached.
   --  ------------------------------
   function Is_Eof (Stream : in Input_Buffer_Stream) return Boolean is
   begin
      return Stream.Eof;
   end Is_Eof;

   --  ------------------------------
   --  Flush the stream and release the buffer.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Input_Buffer_Stream) is
   begin
      if Object.Buffer /= null then
         Free_Buffer (Object.Buffer);
      end if;
   end Finalize;

end Util.Streams.Buffered;

-----------------------------------------------------------------------
--  util-streams-buffered -- Buffered streams utilities
--  Copyright (C) 2010, 2011, 2013, 2014, 2016, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;
package body Util.Streams.Buffered is

   procedure Free_Buffer is
     new Ada.Unchecked_Deallocation (Object => Stream_Element_Array,
                                     Name   => Buffer_Access);

   --  ------------------------------
   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Output  : access Output_Stream'Class;
                         Size    : in Positive) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Size);
      Stream.Buffer    := new Stream_Element_Array (1 .. Stream.Last);
      Stream.Output    := Output;
      Stream.Write_Pos := 1;
      Stream.Read_Pos  := 1;
      Stream.No_Flush  := False;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream to read from the string.
   --  ------------------------------
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Content : in String) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Content'Length);
      Stream.Buffer    := new Stream_Element_Array (1 .. Content'Length);
      Stream.Input     := null;
      Stream.Write_Pos := Stream.Last + 1;
      Stream.Read_Pos  := 1;
      for I in Content'Range loop
         Stream.Buffer (Stream_Element_Offset (I - Content'First + 1))
           := Character'Pos (Content (I));
      end loop;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream with a buffer of Size bytes.
   --  ------------------------------
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Size    : in Positive) is
   begin
      Stream.Initialize (Output => null, Size => Size);
      Stream.No_Flush := True;
      Stream.Read_Pos := 1;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Input   : access Input_Stream'Class;
                         Size    : in Positive) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Size);
      Stream.Buffer    := new Stream_Element_Array (1 .. Stream.Last);
      Stream.Input     := Input;
      Stream.Write_Pos := 1;
      Stream.Read_Pos  := 1;
   end Initialize;

   --  ------------------------------
   --  Close the sink.
   --  ------------------------------
   overriding
   procedure Close (Stream : in out Output_Buffer_Stream) is
   begin
      if Stream.Output /= null then
         Output_Buffer_Stream'Class (Stream).Flush;
         Stream.Output.Close;
      end if;
   end Close;

   --  ------------------------------
   --  Get the direct access to the buffer.
   --  ------------------------------
   function Get_Buffer (Stream : in Output_Buffer_Stream) return Buffer_Access is
   begin
      return Stream.Buffer;
   end Get_Buffer;

   --  ------------------------------
   --  Get the number of element in the stream.
   --  ------------------------------
   function Get_Size (Stream : in Output_Buffer_Stream) return Natural is
   begin
      return Natural (Stream.Write_Pos - Stream.Read_Pos);
   end Get_Size;

   --  ------------------------------
   --  Write the buffer array to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out Output_Buffer_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Start : Stream_Element_Offset := Buffer'First;
      Pos   : Stream_Element_Offset := Stream.Write_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
   begin
      while Start <= Buffer'Last loop
         Size := Buffer'Last - Start + 1;
         Avail := Stream.Last - Pos + 1;
         if Avail = 0 then
            if Stream.Output = null then
               raise Ada.IO_Exceptions.End_Error with "Buffer is full";
            end if;
            Stream.Output.Write (Stream.Buffer (1 .. Pos - 1));
            Stream.Write_Pos := 1;
            Pos := 1;
            Avail := Stream.Last - Pos + 1;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Stream.Buffer (Pos .. Pos + Size - 1) := Buffer (Start .. Start + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Stream.Write_Pos := Pos;

         --  If we have still more data than the buffer size, flush and write
         --  the buffer directly.
         if Start < Buffer'Last and then Buffer'Last - Start > Stream.Buffer'Length then
            if Stream.Output = null then
               raise Ada.IO_Exceptions.End_Error with "Buffer is full";
            end if;
            Stream.Output.Write (Stream.Buffer (1 .. Pos - 1));
            Stream.Write_Pos := 1;
            Stream.Output.Write (Buffer (Start .. Buffer'Last));
            return;
         end if;
      end loop;
   end Write;

   --  ------------------------------
   --  Flush the stream.
   --  ------------------------------
   overriding
   procedure Flush (Stream : in out Output_Buffer_Stream) is
   begin
      if Stream.Write_Pos > 1 and not Stream.No_Flush then
         if Stream.Output /= null then
            Stream.Output.Write (Stream.Buffer (1 .. Stream.Write_Pos - 1));
            Stream.Output.Flush;
         end if;
         Stream.Write_Pos := 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Flush the buffer in the <tt>Into</tt> array and return the index of the
   --  last element (inclusive) in <tt>Last</tt>.
   --  ------------------------------
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Streams.Stream_Element_Array;
                    Last   : out Ada.Streams.Stream_Element_Offset) is
   begin
      if Stream.Write_Pos > 1 then
         Into (Into'First .. Into'First + Stream.Write_Pos - 1) :=
           Stream.Buffer (Stream.Buffer'First .. Stream.Write_Pos - 1);
         Stream.Write_Pos := 1;
         Last := Into'First + Stream.Write_Pos - 1;
      else
         Last := Into'First - 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Flush the buffer stream to the unbounded string.
   --  ------------------------------
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Ada.Strings.Unbounded.Set_Unbounded_String (Into, "");
      if Stream.Write_Pos > 1 then
         for I in 1 .. Stream.Write_Pos - 1 loop
            Ada.Strings.Unbounded.Append (Into, Character'Val (Stream.Buffer (I)));
         end loop;
         Stream.Write_Pos := 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   --  ------------------------------
   procedure Fill (Stream : in out Input_Buffer_Stream) is
   begin
      if Stream.Input = null then
         Stream.Eof := True;
      else
         Stream.Input.Read (Stream.Buffer (1 .. Stream.Last - 1), Stream.Write_Pos);
         Stream.Eof := Stream.Write_Pos < 1;
         if not Stream.Eof then
            Stream.Write_Pos := Stream.Write_Pos + 1;
         end if;
         Stream.Read_Pos := 1;
      end if;
   end Fill;

   --  ------------------------------
   --  Read one character from the input stream.
   --  ------------------------------
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Char   : out Character) is
   begin
      if Stream.Read_Pos >= Stream.Write_Pos then
         Stream.Fill;
         if Stream.Eof then
            raise Ada.IO_Exceptions.Data_Error with "End of buffer";
         end if;
      end if;
      Char := Character'Val (Stream.Buffer (Stream.Read_Pos));
      Stream.Read_Pos := Stream.Read_Pos + 1;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Start : Stream_Element_Offset := Into'First;
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
      Total : Stream_Element_Offset := 0;
   begin
      while Start <= Into'Last loop
         Size := Into'Last - Start + 1;
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            Pos := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
            exit when Avail <= 0;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Into (Start .. Start + Size - 1) := Stream.Buffer (Pos .. Pos + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Total := Total + Size;
         Stream.Read_Pos := Pos;
      end loop;
      Last := Total;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String) is
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
   begin
      loop
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            if Stream.Eof then
               return;
            end if;
            Pos   := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
         end if;
         for I in 1 .. Avail loop
            Ada.Strings.Unbounded.Append (Into, Character'Val (Stream.Buffer (Pos)));
            Pos := Pos + 1;
         end loop;
         Stream.Read_Pos := Pos;
      end loop;
   end Read;

   --  ------------------------------
   --  Flush the stream and release the buffer.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Output_Buffer_Stream) is
   begin
      if Object.Buffer /= null then
         if Object.Output /= null then
            Object.Flush;
         end if;
         Free_Buffer (Object.Buffer);
      end if;
   end Finalize;

   --  ------------------------------
   --  Returns True if the end of the stream is reached.
   --  ------------------------------
   function Is_Eof (Stream : in Input_Buffer_Stream) return Boolean is
   begin
      return Stream.Eof;
   end Is_Eof;

   --  ------------------------------
   --  Flush the stream and release the buffer.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Input_Buffer_Stream) is
   begin
      if Object.Buffer /= null then
         Free_Buffer (Object.Buffer);
      end if;
   end Finalize;

end Util.Streams.Buffered;

Use anonymous access type for the input and output streams