-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  Copyright (C) 2014, 2015 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.Containers.Ordered_Maps;
with Ada.Containers.Vectors;

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   Not_Found : exception;

   type Event_Type is mod 16;
   type Probe_Index_Type is (MSG_BEGIN,
                             MSG_END,
                             MSG_LIBRARY,
                             MSG_MALLOC,
                             MSG_FREE,
                             MSG_REALLOC
                             );

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Tick_Ref;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   --  Find in the list the first event with the given type.
   --  Raise <tt>Not_Found</tt> if the list does not contain such event.
   function Find (List : in Target_Event_Vector;
                  Kind : in Probe_Index_Type) return Probe_Event_Type;

   type Event_Info_Type is record
      First_Event : Target_Event;
      Last_Event  : Target_Event;
      Frame_Addr  : MAT.Types.Target_Addr;
      Count       : Natural;
   end record;

   package Size_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Size,
                                      Element_Type => Event_Info_Type);
   subtype Size_Event_Info_Map is Size_Event_Info_Maps.Map;
   subtype Size_Event_Info_Cursor is Size_Event_Info_Maps.Cursor;

   package Frame_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Event_Info_Type);
   subtype Frame_Event_Info_Map is Frame_Event_Info_Maps.Map;
   subtype Frame_Event_Info_Cursor is Frame_Event_Info_Maps.Cursor;

   package Event_Info_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Event_Info_Type);
   subtype Event_Info_Vector is Event_Info_Vectors.Vector;
   subtype Event_Info_Cursor is Event_Info_Vectors.Cursor;

   --  Extract from the frame info map, the list of event info sorted on the count.
   procedure Build_Event_Info (Map : in Frame_Event_Info_Map;
                               List : in out Event_Info_Vector);

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the probe event with the given allocated unique id.
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type;

   --  Get the first and last event that have been received.
   procedure Get_Limits (Target : in out Target_Events;
                         First  : out Probe_Event_Type;
                         Last   : out Probe_Event_Type);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

   --  Iterate over the events starting from the <tt>Start</tt> event and until the
   --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
   --  with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Start   : in Event_Id_Type;
                      Finish  : in Event_Id_Type;
                      Process : access procedure (Event : in Probe_Event_Type));

   --  Iterate over the events starting from first first event up to the last event collected.
   --  Execute the <tt>Process</tt> procedure with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Process : access procedure (Event : in Target_Event));

private

   EVENT_BLOCK_SIZE : constant Event_Id_Type := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Event_Id_Type := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   package Event_Id_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => Event_Id_Type,
                                      Element_Type => Event_Block_Access);

   subtype Event_Id_Map is Event_Id_Maps.Map;
   subtype Event_Id_Cursor is Event_Id_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the first and last event that have been received.
      procedure Get_Limits (First : out Probe_Event_Type;
                            Last  : out Probe_Event_Type);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

      --  Get the probe event with the given allocated unique id.
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type;

      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type));

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Ids           : Event_Id_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is tagged limited record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

end MAT.Events.Targets;

-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  Copyright (C) 2014, 2015 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.Containers.Ordered_Maps;
with Ada.Containers.Vectors;
with Ada.Finalization;

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   Not_Found : exception;

   type Event_Type is mod 16;
   type Probe_Index_Type is (MSG_BEGIN,
                             MSG_END,
                             MSG_LIBRARY,
                             MSG_MALLOC,
                             MSG_FREE,
                             MSG_REALLOC
                             );

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Tick_Ref;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   --  Find in the list the first event with the given type.
   --  Raise <tt>Not_Found</tt> if the list does not contain such event.
   function Find (List : in Target_Event_Vector;
                  Kind : in Probe_Index_Type) return Probe_Event_Type;

   type Event_Info_Type is record
      First_Event : Target_Event;
      Last_Event  : Target_Event;
      Frame_Addr  : MAT.Types.Target_Addr;
      Count       : Natural;
   end record;

   package Size_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Size,
                                      Element_Type => Event_Info_Type);
   subtype Size_Event_Info_Map is Size_Event_Info_Maps.Map;
   subtype Size_Event_Info_Cursor is Size_Event_Info_Maps.Cursor;

   package Frame_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Event_Info_Type);
   subtype Frame_Event_Info_Map is Frame_Event_Info_Maps.Map;
   subtype Frame_Event_Info_Cursor is Frame_Event_Info_Maps.Cursor;

   package Event_Info_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Event_Info_Type);
   subtype Event_Info_Vector is Event_Info_Vectors.Vector;
   subtype Event_Info_Cursor is Event_Info_Vectors.Cursor;

   --  Extract from the frame info map, the list of event info sorted on the count.
   procedure Build_Event_Info (Map : in Frame_Event_Info_Map;
                               List : in out Event_Info_Vector);

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the probe event with the given allocated unique id.
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type;

   --  Get the first and last event that have been received.
   procedure Get_Limits (Target : in out Target_Events;
                         First  : out Probe_Event_Type;
                         Last   : out Probe_Event_Type);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

   --  Iterate over the events starting from the <tt>Start</tt> event and until the
   --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
   --  with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Start   : in Event_Id_Type;
                      Finish  : in Event_Id_Type;
                      Process : access procedure (Event : in Probe_Event_Type));

   --  Iterate over the events starting from first first event up to the last event collected.
   --  Execute the <tt>Process</tt> procedure with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Process : access procedure (Event : in Target_Event));

private

   EVENT_BLOCK_SIZE : constant Event_Id_Type := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Event_Id_Type := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   package Event_Id_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => Event_Id_Type,
                                      Element_Type => Event_Block_Access);

   subtype Event_Id_Map is Event_Id_Maps.Map;
   subtype Event_Id_Cursor is Event_Id_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the first and last event that have been received.
      procedure Get_Limits (First : out Probe_Event_Type;
                            Last  : out Probe_Event_Type);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

      --  Get the probe event with the given allocated unique id.
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type;

      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type));

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Ids           : Event_Id_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is new Ada.Finalization.Limited_Controlled with record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

   --  Release the storage allocated for the events.
   overriding
   procedure Finalize (Target : in out Target_Events);

end MAT.Events.Targets;

Define the Finalize procedure to finalize the Target_Events type


-----------------------------------------------------------------------
--  util-files-rolling -- Rolling file manager
--  Copyright (C) 2022 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.Calendar;
with Ada.Directories;
with Util.Strings.Vectors;

--  == Rolling file manager ==
--  The `Util.Files.Rolling` package provides a simple support to roll a file
--  based on some rolling policy.  Such rolling is traditionally used for file
--  logs to move files to another place when they reach some size limit or when
--  some date conditions are met (such as a day change).  The file manager uses
--  a file path and a pattern.  The file path is used to define the default
--  or initial file.  The pattern is used when rolling occurs to decide how
--  to reorganize files.
--
--  The file manager defines a triggering policy represented by `Policy_Type`.
--  It controls when the file rolling must be made.
--
--  * `No_Policy`: no policy, the rolling must be triggered manually.
--  * `Size_Policy`: size policy, the rolling is triggered when the file
--     reaches a given size.
--  * `Time_Policy`: time policy, the rolling is made when the date/time pattern
--     no longer applies to the active file; the `Interval` configuration
--     defines the period to check for time changes,
--  * `Size_Time_Policy`: combines the size and time policy, the rolling is
--     triggered when either the file reaches a given size or the date/time
--     pattern no longer applies to the active file.
--
--  To control how the rolling is made, the `Strategy_Type` defines the behavior
--  of the rolling.
--
--  * `Rollover_Strategy`:
--  * `Direct_Strategy`:
--
--  To use the file manager, the first step is to create an instance and configure
--  the default file, pattern, choose the triggering policy and strategy:
--
--    Manager : Util.Files.Rolling.File_Manager;
--
--    Manager.Initialize ("dynamo.log", "dynamo-%i.log",
--                        Policy => (Size_Policy, 100_000),
--                        Strategy => (Rollover_Strategy, 1, 10));
--
--  After the initialization, the current file is retrieved by using the
--  `Get_Current_Path` function and you should call `Is_Rollover_Necessary`
--  before writing content on the file.  When it returns `True`, it means you
--  should call the `Rollover` procedure that will perform roll over according
--  to the rolling strategy.
--
package Util.Files.Rolling is

   type Policy_Kind is (No_Policy, Size_Policy, Time_Policy, Size_Time_Policy);

   type Policy_Type (Kind : Policy_Kind) is record
      case Kind is
         when No_Policy =>
            null;

         when Time_Policy | Size_Policy | Size_Time_Policy =>
            Size     : Ada.Directories.File_Size := 100_000_000;
            Interval : Natural := 0;

      end case;
   end record;

   type Strategy_Kind is (Ascending_Strategy,
                          Descending_Strategy,
                          Direct_Strategy);

   type Strategy_Type (Kind : Strategy_Kind) is record
      case Kind is
         when Ascending_Strategy | Descending_Strategy =>
            Min_Index : Natural;
            Max_Index : Natural;

         when Direct_Strategy =>
            Max_Files : Natural;

      end case;
   end record;

   --  Format the file pattern with the date and index to produce a file path.
   function Format (Pattern : in String;
                    Date    : in Ada.Calendar.Time;
                    Index   : in Natural) return String;

   type File_Manager is tagged limited private;

   --  Initialize the file manager to roll the file referred by `Path` by using
   --  the pattern defined in `Pattern`.
   procedure Initialize (Manager  : in out File_Manager;
                         Path     : in String;
                         Pattern  : in String;
                         Policy   : in Policy_Type;
                         Strategy : in Strategy_Type);

   --  Get the current path (it may or may not exist).
   function Get_Current_Path (Manager : in File_Manager) return String;

   --  Check if a rollover is necessary based on the rolling strategy.
   function Is_Rollover_Necessary (Manager : in out File_Manager) return Boolean;

   --  Perform a rollover according to the strategy that was configured.
   procedure Rollover (Manager : in out File_Manager);

   procedure Rollover_Ascending (Manager : in out File_Manager);
   procedure Rollover_Descending (Manager : in out File_Manager);
   procedure Rollover_Direct (Manager : in out File_Manager);

   --  Get the regex pattern to identify a file that must be purged.
   --  The default is to extract the file pattern part of the file manager pattern.
   function Get_Purge_Pattern (Manager : in File_Manager) return String;

private

   --  Find the files that are eligible to purge in the given directory.
   procedure Eligible_Files (Manager     : in out File_Manager;
                             Path        : in String;
                             Names       : in out Util.Strings.Vectors.Vector;
                             First_Index : out Natural;
                             Last_Index  : out Natural);

   procedure Rename (Manager : in File_Manager;
                     Old     : in String);

   type File_Manager is tagged limited record
      Policy    : Policy_Kind := No_Policy;
      Strategy  : Strategy_Kind := Ascending_Strategy;
      File_Path : Unbounded_String;
      Pattern   : Unbounded_String;
      Interval  : Natural;
      Cur_Index : Natural := 1;
      Min_Index : Natural;
      Max_Index : Natural;
      Max_Files : Natural := 1;
      Deadline  : Ada.Calendar.Time;
      Max_Size  : Ada.Directories.File_Size := Ada.Directories.File_Size'Last;
   end record;

end Util.Files.Rolling;

-----------------------------------------------------------------------
--  util-files-rolling -- Rolling file manager
--  Copyright (C) 2022 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.Calendar;
with Ada.Directories;
with Util.Strings.Vectors;

--  == Rolling file manager ==
--  The `Util.Files.Rolling` package provides a simple support to roll a file
--  based on some rolling policy.  Such rolling is traditionally used for file
--  logs to move files to another place when they reach some size limit or when
--  some date conditions are met (such as a day change).  The file manager uses
--  a file path and a pattern.  The file path is used to define the default
--  or initial file.  The pattern is used when rolling occurs to decide how
--  to reorganize files.
--
--  The file manager defines a triggering policy represented by `Policy_Type`.
--  It controls when the file rolling must be made.
--
--  * `No_Policy`: no policy, the rolling must be triggered manually.
--  * `Size_Policy`: size policy, the rolling is triggered when the file
--     reaches a given size.
--  * `Time_Policy`: time policy, the rolling is made when the date/time pattern
--     no longer applies to the active file; the `Interval` configuration
--     defines the period to check for time changes,
--  * `Size_Time_Policy`: combines the size and time policy, the rolling is
--     triggered when either the file reaches a given size or the date/time
--     pattern no longer applies to the active file.
--
--  To control how the rolling is made, the `Strategy_Type` defines the behavior
--  of the rolling.
--
--  * `Rollover_Strategy`:
--  * `Direct_Strategy`:
--
--  To use the file manager, the first step is to create an instance and configure
--  the default file, pattern, choose the triggering policy and strategy:
--
--    Manager : Util.Files.Rolling.File_Manager;
--
--    Manager.Initialize ("dynamo.log", "dynamo-%i.log",
--                        Policy => (Size_Policy, 100_000),
--                        Strategy => (Rollover_Strategy, 1, 10));
--
--  After the initialization, the current file is retrieved by using the
--  `Get_Current_Path` function and you should call `Is_Rollover_Necessary`
--  before writing content on the file.  When it returns `True`, it means you
--  should call the `Rollover` procedure that will perform roll over according
--  to the rolling strategy.
--
package Util.Files.Rolling is

   type Policy_Kind is (No_Policy, Size_Policy, Time_Policy, Size_Time_Policy);

   type Policy_Type (Kind : Policy_Kind) is record
      case Kind is
         when No_Policy =>
            null;

         when Time_Policy | Size_Policy | Size_Time_Policy =>
            Size     : Ada.Directories.File_Size := 100_000_000;
            Interval : Natural := 0;

      end case;
   end record;

   type Strategy_Kind is (Ascending_Strategy,
                          Descending_Strategy,
                          Direct_Strategy);

   type Strategy_Type (Kind : Strategy_Kind) is record
      case Kind is
         when Ascending_Strategy | Descending_Strategy =>
            Min_Index : Natural;
            Max_Index : Natural;

         when Direct_Strategy =>
            Max_Files : Natural;

      end case;
   end record;

   --  Format the file pattern with the date and index to produce a file path.
   function Format (Pattern : in String;
                    Date    : in Ada.Calendar.Time;
                    Index   : in Natural) return String;

   type File_Manager is tagged limited private;

   --  Initialize the file manager to roll the file referred by `Path` by using
   --  the pattern defined in `Pattern`.
   procedure Initialize (Manager  : in out File_Manager;
                         Path     : in String;
                         Pattern  : in String;
                         Policy   : in Policy_Type;
                         Strategy : in Strategy_Type);

   --  Get the current path (it may or may not exist).
   function Get_Current_Path (Manager : in File_Manager) return String;

   --  Check if a rollover is necessary based on the rolling strategy.
   function Is_Rollover_Necessary (Manager : in out File_Manager) return Boolean;

   --  Perform a rollover according to the strategy that was configured.
   procedure Rollover (Manager : in out File_Manager);

   procedure Rollover_Ascending (Manager : in out File_Manager);
   procedure Rollover_Descending (Manager : in out File_Manager);
   procedure Rollover_Direct (Manager : in out File_Manager);

   --  Get the regex pattern to identify a file that must be purged.
   --  The default is to extract the file pattern part of the file manager pattern.
   function Get_Purge_Pattern (Manager : in File_Manager) return String;

private

   --  Find the files that are eligible to purge in the given directory.
   procedure Eligible_Files (Manager     : in out File_Manager;
                             Path        : in String;
                             Names       : in out Util.Strings.Vectors.Vector;
                             First_Index : out Natural;
                             Last_Index  : out Natural);

   procedure Rename (Manager : in out File_Manager;
                     Old     : in String);

   type File_Manager is tagged limited record
      Policy    : Policy_Kind := No_Policy;
      Strategy  : Strategy_Kind := Ascending_Strategy;
      File_Path : Unbounded_String;
      Last_Path : Unbounded_String;
      Pattern   : Unbounded_String;
      Interval  : Natural;
      Cur_Index : Natural := 1;
      Min_Index : Natural;
      Max_Index : Natural;
      Max_Files : Natural := 1;
      Deadline  : Ada.Calendar.Time;
      Max_Size  : Ada.Directories.File_Size := Ada.Directories.File_Size'Last;
   end record;

end Util.Files.Rolling;

Add Last_Path and record it when Rename is called


-----------------------------------------------------------------------
--  babel-stores -- Storage management
--  Copyright (C) 2014, 2015, 2016 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 Babel.Files;
with Babel.Files.Buffers;
with Babel.Filters;
with Babel.Streams;
with Babel.Streams.Refs;
package Babel.Stores is

   type Store_Type is limited interface;
   type Store_Type_Access is access all Store_Type'Class;

   --  Open a file in the store to read its content with a stream.
   procedure Open_File (Store  : in out Store_Type;
                        Path   : in String;
                        Stream : out Babel.Streams.Stream_Access) is abstract;

   --  Open a file in the store to read its content with a stream.
   procedure Read_File (Store  : in out Store_Type;
                        Path   : in String;
                        Stream : out Babel.Streams.Refs.Stream_Ref) is abstract;

   --  Write a file in the store with a stream.
   procedure Write_File (Store  : in out Store_Type;
                         Path   : in String;
                         Stream : in Babel.Streams.Refs.Stream_Ref;
                         Mode   : in Util.Systems.Types.mode_t) is abstract;

   procedure Read (Store : in out Store_Type;
                   Path  : in String;
                   Into  : in out Babel.Files.Buffers.Buffer) is abstract;

   procedure Write (Store : in out Store_Type;
                    Path  : in String;
                    Into  : in Babel.Files.Buffers.Buffer) is abstract;

   procedure Scan (Store  : in out Store_Type;
                   Path   : in String;
                   Into   : in out Babel.Files.File_Container'Class;
                   Filter : in Babel.Filters.Filter_Type'Class) is abstract;

end Babel.Stores;

-----------------------------------------------------------------------
--  babel-stores -- Storage management
--  Copyright (C) 2014, 2015, 2016 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 Babel.Files;
with Babel.Files.Buffers;
with Babel.Filters;
with Babel.Streams;
with Babel.Streams.Refs;
package Babel.Stores is

   type Store_Type is limited interface;
   type Store_Type_Access is access all Store_Type'Class;

   --  Open a file in the store to read its content with a stream.
   procedure Open_File (Store  : in out Store_Type;
                        Path   : in String;
                        Stream : out Babel.Streams.Stream_Access) is abstract;

   --  Open a file in the store to read its content with a stream.
   procedure Read_File (Store  : in out Store_Type;
                        Path   : in String;
                        Stream : out Babel.Streams.Refs.Stream_Ref) is abstract;

   --  Write a file in the store with a stream.
   procedure Write_File (Store  : in out Store_Type;
                         Path   : in String;
                         Stream : in Babel.Streams.Refs.Stream_Ref;
                         Mode   : in Babel.Files.File_Mode) is abstract;

   procedure Read (Store : in out Store_Type;
                   Path  : in String;
                   Into  : in out Babel.Files.Buffers.Buffer) is abstract;

   procedure Write (Store : in out Store_Type;
                    Path  : in String;
                    Into  : in Babel.Files.Buffers.Buffer) is abstract;

   procedure Scan (Store  : in out Store_Type;
                   Path   : in String;
                   Into   : in out Babel.Files.File_Container'Class;
                   Filter : in Babel.Filters.Filter_Type'Class) is abstract;

end Babel.Stores;

Change Write_File to use the Babel.Files.File_Mode type


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;

with Orka.Strings;
with Orka.Logging;

package body AWT.Inputs.Gamepads.Mappings is

   use all type Orka.Logging.Source;
   use all type Orka.Logging.Severity;
   use Orka.Logging;

   package Messages is new Orka.Logging.Messages (Window_System);

   package SF renames Ada.Strings.Fixed;

   function GUID_Hash (Key : GUID_String) return Ada.Containers.Hash_Type is
     (Ada.Strings.Hash (String (Key)));

   package Mapping_Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type        => GUID_String,
      Element_Type    => String,
      Hash            => GUID_Hash,
      Equivalent_Keys => "=");

   Mappings : Mapping_Maps.Map;

   procedure Set_Mappings (Platform : Platform_Kind; Text : String) is
      Lines : constant Orka.Strings.String_List := Orka.Strings.Split (Text, "" & L1.LF);

      Platform_Value : constant String :=
        (case Platform is
           when Linux    => "Linux",
           when Windows  => "Windows",
           when Mac_OS_X => "Mac OS X",
           when iOS      => "iOS",
           when Android  => "Android");
      Platform_String : constant String := ",platform:" & Platform_Value & ",";

      Count : Natural := 0;

      use type SU.Unbounded_String;
   begin
      for Line of Lines loop
         declare
            Mapping : constant Orka.Strings.String_List := Orka.Strings.Split (+Line, ",", 2);
         begin
            if Mapping'Length = 2 and SU.Index (Line, "#") /= 1 then
               declare
                  GUID  : constant String := (+Mapping (1));
                  Value : constant String := (+Mapping (2));

                  Value_Without_Platform : String renames
                    Value (Value'First .. Value'Last - Platform_String'Length);
                  Platform : String renames
                    Value (Value'Last - Platform_String'Length + 1 .. Value'Last);

                  pragma Assert (GUID = "xinput" or GUID'Length = GUID_String'Length);
               begin
                  if Platform = Platform_String and GUID /= "xinput" then
                     Mappings.Insert (GUID_String (GUID), Value_Without_Platform);
                     Count := Count + 1;
                  end if;
               end;
            end if;
         end;
      end loop;

      Messages.Log (Debug,
        "Added " & Trim (Count'Image) & " gamepad mappings for " & Platform_Value & " platform");
   end Set_Mappings;

   function Contains (GUID : GUID_String) return Boolean is
     (Mappings.Contains (GUID));

   function Get (GUID : GUID_String) return String is (Mappings (GUID));

   function Name_To_Output (Name : String) return Output_Mapping is
   begin
      --  Buttons
      if Name = "a" then
         return (Kind => Button, Button => Action_Down);
      elsif Name = "b" then
         return (Kind => Button, Button => Action_Right);
      elsif Name = "x" then
         return (Kind => Button, Button => Action_Left);
      elsif Name = "y" then
         return (Kind => Button, Button => Action_Up);

      elsif Name = "dpup" then
         return (Kind => Button, Button => Direction_Up);
      elsif Name = "dpright" then
         return (Kind => Button, Button => Direction_Right);
      elsif Name = "dpdown" then
         return (Kind => Button, Button => Direction_Down);
      elsif Name = "dpleft" then
         return (Kind => Button, Button => Direction_Left);

      elsif Name = "leftshoulder" then
         return (Kind => Button, Button => Shoulder_Left);
      elsif Name = "rightshoulder" then
         return (Kind => Button, Button => Shoulder_Right);

      elsif Name = "back" then
         return (Kind => Button, Button => Center_Left);
      elsif Name = "start" then
         return (Kind => Button, Button => Center_Right);
      elsif Name = "guide" then
         return (Kind => Button, Button => Center_Logo);

      elsif Name = "leftstick" then
         return (Kind => Button, Button => Thumb_Left);
      elsif Name = "rightstick" then
         return (Kind => Button, Button => Thumb_Right);

      --  Axes
      elsif Name = "leftx" then
         return (Kind => Axis, Axis => Stick_Left_X, others => <>);
      elsif Name = "lefty" then
         return (Kind => Axis, Axis => Stick_Left_Y, others => <>);

      elsif Name = "rightx" then
         return (Kind => Axis, Axis => Stick_Right_X, others => <>);
      elsif Name = "righty" then
         return (Kind => Axis, Axis => Stick_Right_Y, others => <>);

      --  Triggers
      elsif Name = "lefttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Left);
      elsif Name = "righttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Right);

      else
         raise Constraint_Error;
      end if;
   end Name_To_Output;

   function Parse_Mapping
     (Line        : String;
      Set_Mapping : not null access procedure
        (Kind       : Mapping_Kind;
         Input_Map  : Input_Mapping;
         Output_Map : Output_Mapping;
         Name       : String)) return String
   is
      Index : constant Natural := SF.Index (Line, ",");
      pragma Assert (Index > 0);

      Name  : constant String := Line (Line'First .. Index - 1);
      Value : constant String := Line (Index + 1 .. Line'Last);
   begin
      for Mapping of Orka.Strings.Split (Value, ",") loop
         declare
            Button_Input : constant Orka.Strings.String_List := Orka.Strings.Split (+Mapping, ":");
            pragma Assert (Button_Input'Length = 2);

            Button : constant String := (+Button_Input (1));
            Input  : constant String := (+Button_Input (2));

            Index : Natural := Button'First;
            Last  : Natural := Input'Last;

            Output_Positive : Boolean := False;
            Output_Negative : Boolean := False;

            Input_Positive : Boolean := False;
            Input_Negative : Boolean := False;
            Input_Invert   : Boolean := False;

            Input_Map  : Input_Mapping;
            Output_Map : Output_Mapping;
         begin
            --  Each mapping has the following format:
            --
            --  [+|-]<output>:[+|-]<input>[~]
            --
            --  The output is the name of a button, axis, or trigger.
            --  (See function Name_To_Output above)
            --
            --  The input starts with an 'a' (axis), 'b' (button), or 'h' (hat)
            --  followed by a natural number.
            --
            --  The '+' or '-' character just after the ':' is only used
            --  if the input is an axis.
            --
            --  (output +/- only for non-triggers)
            --  output: '-': map final input to -1 .. 0
            --  |       '+': map final input to  0 .. 1
            --  |   (empty): map final input to -1 .. 1
            --  v
            --  +leftx:h0.2,-leftx:h0.8
            --  lefttrigger:a3~
            --  dpleft:-a0    ^
            --         ^      |
            --         |      invert input: map normalized input from 0 .. 1 to 1 .. 0
            --         |
            --         input: '-': if axis is in negative half, use and normalize input to 0 .. 1
            --                '+': if axis is in positive half, use and normalize input to 0 .. 1

            if Button (Index) = '+' then
               Output_Positive := True;
               Index := Index + 1;
            elsif Button (Index) = '-' then
               Output_Negative := True;
               Index := Index + 1;
            end if;

            Output_Map := Name_To_Output (Button (Index .. Button'Last));

            if Output_Map.Kind = Axis then
               if Output_Positive then
                  Output_Map.Scale := 1.0;
                  Output_Map.Offset := 0.0;
               elsif Output_Negative then
                  Output_Map.Scale := -1.0;
                  Output_Map.Offset := 0.0;
               end if;
            end if;

            Index := Input'First;

            if Input (Index) in '+' then
               Input_Positive := True;
               Index := Index + 1;
            elsif Input (Index) in '-' then
               Input_Negative := True;
               Index := Index + 1;
            end if;

            if Input (Last) in '~' then
               Input_Invert := True;
               Last := Last - 1;
            end if;

            if Input (Index) = 'a' then
               if Input_Positive then
                  Input_Map.Side := Positive_Half;
               elsif Input_Negative then
                  Input_Map.Side := Negative_Half;
               end if;
               if Input_Invert then
                  Input_Map.Invert := True;
               end if;

               Set_Mapping (Axis_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'b' then
               Set_Mapping (Button_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'h' then
               Set_Mapping (Hat_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            else
               raise Constraint_Error;
            end if;
         end;
      end loop;

      return Name;
   end Parse_Mapping;

end AWT.Inputs.Gamepads.Mappings;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;

with Orka.Strings;
with Orka.Logging;

package body AWT.Inputs.Gamepads.Mappings is

   use all type Orka.Logging.Source;
   use all type Orka.Logging.Severity;
   use Orka.Logging;

   package Messages is new Orka.Logging.Messages (Window_System);

   package SF renames Ada.Strings.Fixed;

   function GUID_Hash (Key : GUID_String) return Ada.Containers.Hash_Type is
     (Ada.Strings.Hash (String (Key)));

   package Mapping_Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type        => GUID_String,
      Element_Type    => String,
      Hash            => GUID_Hash,
      Equivalent_Keys => "=");

   Mappings : Mapping_Maps.Map;

   procedure Set_Mappings (Platform : Platform_Kind; Text : String) is
      Lines : constant Orka.Strings.String_List := Orka.Strings.Split (Text, "" & L1.LF);

      Platform_Value : constant String :=
        (case Platform is
           when Linux    => "Linux",
           when Windows  => "Windows",
           when Mac_OS_X => "Mac OS X",
           when iOS      => "iOS",
           when Android  => "Android");
      Platform_String : constant String := ",platform:" & Platform_Value & ",";

      Count : Natural := 0;

      use type SU.Unbounded_String;
   begin
      for Line of Lines loop
         declare
            Mapping : constant Orka.Strings.String_List := Orka.Strings.Split (+Line, ",", 2);
         begin
            if Mapping'Length = 2 and SU.Index (Line, "#") /= 1 then
               declare
                  GUID  : constant String := (+Mapping (1));
                  Value : constant String := (+Mapping (2));

                  Value_Without_Platform : String renames
                    Value (Value'First .. Value'Last - Platform_String'Length);
                  Platform : String renames
                    Value (Value'Last - Platform_String'Length + 1 .. Value'Last);

                  pragma Assert (GUID = "xinput" or GUID'Length = GUID_String'Length);
               begin
                  if Platform = Platform_String and GUID /= "xinput" then
                     Mappings.Insert (GUID_String (GUID), Value_Without_Platform);
                     Count := Count + 1;
                  end if;
               end;
            end if;
         end;
      end loop;

      Messages.Log (Debug,
        "Added " & Trim (Count'Image) & " gamepad mappings for " & Platform_Value & " platform");
   end Set_Mappings;

   function Contains (GUID : GUID_String) return Boolean is
     (Mappings.Contains (GUID));

   function Get (GUID : GUID_String) return String is (Mappings (GUID));

   function Name_To_Output (Name : String) return Output_Mapping is
   begin
      --  Buttons
      if Name = "a" then
         return (Kind => Button, Button => Action_Down);
      elsif Name = "b" then
         return (Kind => Button, Button => Action_Right);
      elsif Name = "x" then
         return (Kind => Button, Button => Action_Left);
      elsif Name = "y" then
         return (Kind => Button, Button => Action_Up);

      elsif Name = "dpup" then
         return (Kind => Button, Button => Direction_Up);
      elsif Name = "dpright" then
         return (Kind => Button, Button => Direction_Right);
      elsif Name = "dpdown" then
         return (Kind => Button, Button => Direction_Down);
      elsif Name = "dpleft" then
         return (Kind => Button, Button => Direction_Left);

      elsif Name = "leftshoulder" then
         return (Kind => Button, Button => Shoulder_Left);
      elsif Name = "rightshoulder" then
         return (Kind => Button, Button => Shoulder_Right);

      elsif Name = "back" then
         return (Kind => Button, Button => Center_Left);
      elsif Name = "start" then
         return (Kind => Button, Button => Center_Right);
      elsif Name = "guide" then
         return (Kind => Button, Button => Center_Logo);

      elsif Name = "leftstick" then
         return (Kind => Button, Button => Thumb_Left);
      elsif Name = "rightstick" then
         return (Kind => Button, Button => Thumb_Right);

      --  Axes
      elsif Name = "leftx" then
         return (Kind => Axis, Axis => Stick_Left_X, others => <>);
      elsif Name = "lefty" then
         return (Kind => Axis, Axis => Stick_Left_Y, others => <>);

      elsif Name = "rightx" then
         return (Kind => Axis, Axis => Stick_Right_X, others => <>);
      elsif Name = "righty" then
         return (Kind => Axis, Axis => Stick_Right_Y, others => <>);

      --  Triggers
      elsif Name = "lefttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Left);
      elsif Name = "righttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Right);

      else
         raise Constraint_Error;
      end if;
   end Name_To_Output;

   function Parse_Mapping
     (Line        : String;
      Set_Mapping : not null access procedure
        (Kind       : Mapping_Kind;
         Input_Map  : Input_Mapping;
         Output_Map : Output_Mapping;
         Name       : String)) return String
   is
      Index : constant Natural := SF.Index (Line, ",");
      pragma Assert (Index > 0);

      Name  : constant String := Line (Line'First .. Index - 1);
      Value : constant String := Line (Index + 1 .. Line'Last);
   begin
      for Mapping of Orka.Strings.Split (Value, ",") loop
         declare
            Output_Input : constant Orka.Strings.String_List := Orka.Strings.Split (+Mapping, ":");
            pragma Assert (Output_Input'Length = 2);

            Output : constant String := (+Output_Input (1));
            Input  : constant String := (+Output_Input (2));

            Index : Natural := Output'First;
            Last  : Natural := Input'Last;

            Output_Positive : Boolean := False;
            Output_Negative : Boolean := False;

            Input_Positive : Boolean := False;
            Input_Negative : Boolean := False;
            Input_Invert   : Boolean := False;

            Input_Map  : Input_Mapping;
            Output_Map : Output_Mapping;
         begin
            --  Each mapping has the following format:
            --
            --  [+|-]<output>:[+|-]<input>[~]
            --
            --  The output is the name of a button, axis, or trigger.
            --  (See function Name_To_Output above)
            --
            --  The input starts with an 'a' (axis), 'b' (button), or 'h' (hat)
            --  followed by a natural number.
            --
            --  The '+' or '-' character just after the ':' is only used
            --  if the input is an axis.
            --
            --  (output +/- only for non-triggers)
            --  output: '-': map final input to -1 .. 0
            --  |       '+': map final input to  0 .. 1
            --  |   (empty): map final input to -1 .. 1
            --  v
            --  +leftx:h0.2,-leftx:h0.8
            --  lefttrigger:a3~
            --  dpleft:-a0    ^
            --         ^      |
            --         |      invert input: map normalized input from 0 .. 1 to 1 .. 0
            --         |
            --         input: '-': if axis is in negative half, use and normalize input to 0 .. 1
            --                '+': if axis is in positive half, use and normalize input to 0 .. 1

            if Output (Index) = '+' then
               Output_Positive := True;
               Index := Index + 1;
            elsif Output (Index) = '-' then
               Output_Negative := True;
               Index := Index + 1;
            end if;

            Output_Map := Name_To_Output (Output (Index .. Output'Last));

            if Output_Map.Kind = Axis then
               if Output_Positive then
                  Output_Map.Scale := 1.0;
                  Output_Map.Offset := 0.0;
               elsif Output_Negative then
                  Output_Map.Scale := -1.0;
                  Output_Map.Offset := 0.0;
               end if;
            end if;

            Index := Input'First;

            if Input (Index) in '+' then
               Input_Positive := True;
               Index := Index + 1;
            elsif Input (Index) in '-' then
               Input_Negative := True;
               Index := Index + 1;
            end if;

            if Input (Last) in '~' then
               Input_Invert := True;
               Last := Last - 1;
            end if;

            if Input (Index) = 'a' then
               if Input_Positive then
                  Input_Map.Side := Positive_Half;
               elsif Input_Negative then
                  Input_Map.Side := Negative_Half;
               end if;
               if Input_Invert then
                  Input_Map.Invert := True;
               end if;

               Set_Mapping (Axis_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'b' then
               Set_Mapping (Button_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'h' then
               Set_Mapping (Hat_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            else
               raise Constraint_Error;
            end if;
         end;
      end loop;

      return Name;
   end Parse_Mapping;

end AWT.Inputs.Gamepads.Mappings;

awt: Rename some variables in function Parse_Mapping

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;

with Orka.Strings;
with Orka.Logging;

package body AWT.Inputs.Gamepads.Mappings is

   use all type Orka.Logging.Source;
   use all type Orka.Logging.Severity;
   use Orka.Logging;

   package Messages is new Orka.Logging.Messages (Window_System);

   package SF renames Ada.Strings.Fixed;

   function GUID_Hash (Key : GUID_String) return Ada.Containers.Hash_Type is
     (Ada.Strings.Hash (String (Key)));

   package Mapping_Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type        => GUID_String,
      Element_Type    => String,
      Hash            => GUID_Hash,
      Equivalent_Keys => "=");

   Mappings : Mapping_Maps.Map;

   procedure Set_Mappings (Platform : Platform_Kind; Text : String) is
      Lines : constant Orka.Strings.String_List := Orka.Strings.Split (Text, "" & L1.LF);

      Platform_Value : constant String :=
        (case Platform is
           when Linux    => "Linux",
           when Windows  => "Windows",
           when Mac_OS_X => "Mac OS X",
           when iOS      => "iOS",
           when Android  => "Android");
      Platform_String : constant String := ",platform:" & Platform_Value & ",";

      Count : Natural := 0;

      use type SU.Unbounded_String;
   begin
      for Line of Lines loop
         declare
            Mapping : constant Orka.Strings.String_List := Orka.Strings.Split (+Line, ",", 2);
         begin
            if Mapping'Length = 2 and SU.Index (Line, "#") /= 1 then
               declare
                  GUID  : constant String := (+Mapping (1));
                  Value : constant String := (+Mapping (2));

                  Value_Without_Platform : String renames
                    Value (Value'First .. Value'Last - Platform_String'Length);
                  Platform : String renames
                    Value (Value'Last - Platform_String'Length + 1 .. Value'Last);

                  pragma Assert (GUID = "xinput" or GUID'Length = GUID_String'Length);
               begin
                  if Platform = Platform_String and GUID /= "xinput" then
                     Mappings.Insert (GUID_String (GUID), Value_Without_Platform);
                     Count := Count + 1;
                  end if;
               end;
            end if;
         end;
      end loop;

      Messages.Log (Debug,
        "Added " & Trim (Count'Image) & " gamepad mappings for " & Platform_Value & " platform");
   end Set_Mappings;

   function Contains (GUID : GUID_String) return Boolean is
     (Mappings.Contains (GUID));

   function Get (GUID : GUID_String) return String is (Mappings (GUID));

   function Name_To_Output (Name : String) return Output_Mapping is
   begin
      --  Buttons
      if Name = "a" then
         return (Kind => Button, Button => Action_Down);
      elsif Name = "b" then
         return (Kind => Button, Button => Action_Right);
      elsif Name = "x" then
         return (Kind => Button, Button => Action_Left);
      elsif Name = "y" then
         return (Kind => Button, Button => Action_Up);

      elsif Name = "dpup" then
         return (Kind => Button, Button => Direction_Up);
      elsif Name = "dpright" then
         return (Kind => Button, Button => Direction_Right);
      elsif Name = "dpdown" then
         return (Kind => Button, Button => Direction_Down);
      elsif Name = "dpleft" then
         return (Kind => Button, Button => Direction_Left);

      elsif Name = "leftshoulder" then
         return (Kind => Button, Button => Shoulder_Left);
      elsif Name = "rightshoulder" then
         return (Kind => Button, Button => Shoulder_Right);

      elsif Name = "back" then
         return (Kind => Button, Button => Center_Left);
      elsif Name = "start" then
         return (Kind => Button, Button => Center_Right);
      elsif Name = "guide" then
         return (Kind => Button, Button => Center_Logo);

      elsif Name = "leftstick" then
         return (Kind => Button, Button => Thumb_Left);
      elsif Name = "rightstick" then
         return (Kind => Button, Button => Thumb_Right);

      --  Axes
      elsif Name = "leftx" then
         return (Kind => Axis, Axis => Stick_Left_X, others => <>);
      elsif Name = "lefty" then
         return (Kind => Axis, Axis => Stick_Left_Y, others => <>);

      elsif Name = "rightx" then
         return (Kind => Axis, Axis => Stick_Right_X, others => <>);
      elsif Name = "righty" then
         return (Kind => Axis, Axis => Stick_Right_Y, others => <>);

      --  Triggers
      elsif Name = "lefttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Left);
      elsif Name = "righttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Right);

      else
         raise Constraint_Error;
      end if;
   end Name_To_Output;

   function Parse_Mapping
     (Line        : String;
      Set_Mapping : not null access procedure
        (Kind       : Mapping_Kind;
         Input_Map  : Input_Mapping;
         Output_Map : Output_Mapping;
         Name       : String)) return String
   is
      Index : constant Natural := SF.Index (Line, ",");
      pragma Assert (Index > 0);

      Name  : constant String := Line (Line'First .. Index - 1);
      Value : constant String := Line (Index + 1 .. Line'Last);
   begin
      for Mapping of Orka.Strings.Split (Value, ",") loop
         declare
            Button_Input : constant Orka.Strings.String_List := Orka.Strings.Split (+Mapping, ":");
            pragma Assert (Button_Input'Length = 2);

            Button : constant String := (+Button_Input (1));
            Input  : constant String := (+Button_Input (2));

            Index : Natural := Button'First;
            Last  : Natural := Input'Last;

            Output_Positive : Boolean := False;
            Output_Negative : Boolean := False;

            Input_Positive : Boolean := False;
            Input_Negative : Boolean := False;
            Input_Invert   : Boolean := False;

            Input_Map  : Input_Mapping;
            Output_Map : Output_Mapping;
         begin
            if Button (Index) = '+' then
               Output_Positive := True;
               Index := Index + 1;
            elsif Button (Index) = '-' then
               Output_Negative := True;
               Index := Index + 1;
            end if;

            Output_Map := Name_To_Output (Button (Index .. Button'Last));

            if Output_Map.Kind = Axis then
               if Output_Positive then
                  Output_Map.Scale := 1.0;
                  Output_Map.Offset := 0.0;
               elsif Output_Negative then
                  Output_Map.Scale := -1.0;
                  Output_Map.Offset := 0.0;
               end if;
            end if;

            Index := Input'First;

            if Input (Index) in '+' then
               Input_Positive := True;
               Index := Index + 1;
            elsif Input (Index) in '-' then
               Input_Negative := True;
               Index := Index + 1;
            end if;

            if Input (Last) in '~' then
               Input_Invert := True;
               Last := Last - 1;
            end if;

            if Input (Index) = 'a' then
               if Input_Positive then
                  Input_Map.Side := Positive_Half;
               elsif Input_Negative then
                  Input_Map.Side := Negative_Half;
               end if;
               if Input_Invert then
                  Input_Map.Invert := True;
               end if;

               Set_Mapping (Axis_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'b' then
               Set_Mapping (Button_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'h' then
               Set_Mapping (Hat_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            else
               raise Constraint_Error;
            end if;
         end;
      end loop;

      return Name;
   end Parse_Mapping;

end AWT.Inputs.Gamepads.Mappings;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;

with Orka.Strings;
with Orka.Logging;

package body AWT.Inputs.Gamepads.Mappings is

   use all type Orka.Logging.Source;
   use all type Orka.Logging.Severity;
   use Orka.Logging;

   package Messages is new Orka.Logging.Messages (Window_System);

   package SF renames Ada.Strings.Fixed;

   function GUID_Hash (Key : GUID_String) return Ada.Containers.Hash_Type is
     (Ada.Strings.Hash (String (Key)));

   package Mapping_Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type        => GUID_String,
      Element_Type    => String,
      Hash            => GUID_Hash,
      Equivalent_Keys => "=");

   Mappings : Mapping_Maps.Map;

   procedure Set_Mappings (Platform : Platform_Kind; Text : String) is
      Lines : constant Orka.Strings.String_List := Orka.Strings.Split (Text, "" & L1.LF);

      Platform_Value : constant String :=
        (case Platform is
           when Linux    => "Linux",
           when Windows  => "Windows",
           when Mac_OS_X => "Mac OS X",
           when iOS      => "iOS",
           when Android  => "Android");
      Platform_String : constant String := ",platform:" & Platform_Value & ",";

      Count : Natural := 0;

      use type SU.Unbounded_String;
   begin
      for Line of Lines loop
         declare
            Mapping : constant Orka.Strings.String_List := Orka.Strings.Split (+Line, ",", 2);
         begin
            if Mapping'Length = 2 and SU.Index (Line, "#") /= 1 then
               declare
                  GUID  : constant String := (+Mapping (1));
                  Value : constant String := (+Mapping (2));

                  Value_Without_Platform : String renames
                    Value (Value'First .. Value'Last - Platform_String'Length);
                  Platform : String renames
                    Value (Value'Last - Platform_String'Length + 1 .. Value'Last);

                  pragma Assert (GUID = "xinput" or GUID'Length = GUID_String'Length);
               begin
                  if Platform = Platform_String and GUID /= "xinput" then
                     Mappings.Insert (GUID_String (GUID), Value_Without_Platform);
                     Count := Count + 1;
                  end if;
               end;
            end if;
         end;
      end loop;

      Messages.Log (Debug,
        "Added " & Trim (Count'Image) & " gamepad mappings for " & Platform_Value & " platform");
   end Set_Mappings;

   function Contains (GUID : GUID_String) return Boolean is
     (Mappings.Contains (GUID));

   function Get (GUID : GUID_String) return String is (Mappings (GUID));

   function Name_To_Output (Name : String) return Output_Mapping is
   begin
      --  Buttons
      if Name = "a" then
         return (Kind => Button, Button => Action_Down);
      elsif Name = "b" then
         return (Kind => Button, Button => Action_Right);
      elsif Name = "x" then
         return (Kind => Button, Button => Action_Left);
      elsif Name = "y" then
         return (Kind => Button, Button => Action_Up);

      elsif Name = "dpup" then
         return (Kind => Button, Button => Direction_Up);
      elsif Name = "dpright" then
         return (Kind => Button, Button => Direction_Right);
      elsif Name = "dpdown" then
         return (Kind => Button, Button => Direction_Down);
      elsif Name = "dpleft" then
         return (Kind => Button, Button => Direction_Left);

      elsif Name = "leftshoulder" then
         return (Kind => Button, Button => Shoulder_Left);
      elsif Name = "rightshoulder" then
         return (Kind => Button, Button => Shoulder_Right);

      elsif Name = "back" then
         return (Kind => Button, Button => Center_Left);
      elsif Name = "start" then
         return (Kind => Button, Button => Center_Right);
      elsif Name = "guide" then
         return (Kind => Button, Button => Center_Logo);

      elsif Name = "leftstick" then
         return (Kind => Button, Button => Thumb_Left);
      elsif Name = "rightstick" then
         return (Kind => Button, Button => Thumb_Right);

      --  Axes
      elsif Name = "leftx" then
         return (Kind => Axis, Axis => Stick_Left_X, others => <>);
      elsif Name = "lefty" then
         return (Kind => Axis, Axis => Stick_Left_Y, others => <>);

      elsif Name = "rightx" then
         return (Kind => Axis, Axis => Stick_Right_X, others => <>);
      elsif Name = "righty" then
         return (Kind => Axis, Axis => Stick_Right_Y, others => <>);

      --  Triggers
      elsif Name = "lefttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Left);
      elsif Name = "righttrigger" then
         return (Kind => Trigger, Trigger => Trigger_Right);

      else
         raise Constraint_Error;
      end if;
   end Name_To_Output;

   function Parse_Mapping
     (Line        : String;
      Set_Mapping : not null access procedure
        (Kind       : Mapping_Kind;
         Input_Map  : Input_Mapping;
         Output_Map : Output_Mapping;
         Name       : String)) return String
   is
      Index : constant Natural := SF.Index (Line, ",");
      pragma Assert (Index > 0);

      Name  : constant String := Line (Line'First .. Index - 1);
      Value : constant String := Line (Index + 1 .. Line'Last);
   begin
      for Mapping of Orka.Strings.Split (Value, ",") loop
         declare
            Button_Input : constant Orka.Strings.String_List := Orka.Strings.Split (+Mapping, ":");
            pragma Assert (Button_Input'Length = 2);

            Button : constant String := (+Button_Input (1));
            Input  : constant String := (+Button_Input (2));

            Index : Natural := Button'First;
            Last  : Natural := Input'Last;

            Output_Positive : Boolean := False;
            Output_Negative : Boolean := False;

            Input_Positive : Boolean := False;
            Input_Negative : Boolean := False;
            Input_Invert   : Boolean := False;

            Input_Map  : Input_Mapping;
            Output_Map : Output_Mapping;
         begin
            --  Each mapping has the following format:
            --
            --  [+|-]<output>:[+|-]<input>[~]
            --
            --  The output is the name of a button, axis, or trigger.
            --  (See function Name_To_Output above)
            --
            --  The input starts with an 'a' (axis), 'b' (button), or 'h' (hat)
            --  followed by a natural number.
            --
            --  The '+' or '-' character just after the ':' is only used
            --  if the input is an axis.
            --
            --  (output +/- only for non-triggers)
            --  output: '-': map final input to -1 .. 0
            --  |       '+': map final input to  0 .. 1
            --  |   (empty): map final input to -1 .. 1
            --  v
            --  +leftx:h0.2,-leftx:h0.8
            --  lefttrigger:a3~
            --  dpleft:-a0    ^
            --         ^      |
            --         |      invert input: map normalized input from 0 .. 1 to 1 .. 0
            --         |
            --         input: '-': if axis is in negative half, use and normalize input to 0 .. 1
            --                '+': if axis is in positive half, use and normalize input to 0 .. 1

            if Button (Index) = '+' then
               Output_Positive := True;
               Index := Index + 1;
            elsif Button (Index) = '-' then
               Output_Negative := True;
               Index := Index + 1;
            end if;

            Output_Map := Name_To_Output (Button (Index .. Button'Last));

            if Output_Map.Kind = Axis then
               if Output_Positive then
                  Output_Map.Scale := 1.0;
                  Output_Map.Offset := 0.0;
               elsif Output_Negative then
                  Output_Map.Scale := -1.0;
                  Output_Map.Offset := 0.0;
               end if;
            end if;

            Index := Input'First;

            if Input (Index) in '+' then
               Input_Positive := True;
               Index := Index + 1;
            elsif Input (Index) in '-' then
               Input_Negative := True;
               Index := Index + 1;
            end if;

            if Input (Last) in '~' then
               Input_Invert := True;
               Last := Last - 1;
            end if;

            if Input (Index) = 'a' then
               if Input_Positive then
                  Input_Map.Side := Positive_Half;
               elsif Input_Negative then
                  Input_Map.Side := Negative_Half;
               end if;
               if Input_Invert then
                  Input_Map.Invert := True;
               end if;

               Set_Mapping (Axis_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'b' then
               Set_Mapping (Button_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            elsif Input (Index) = 'h' then
               Set_Mapping (Hat_Mapping, Input_Map, Output_Map, Input (Index + 1 .. Last));
            else
               raise Constraint_Error;
            end if;
         end;
      end loop;

      return Name;
   end Parse_Mapping;

end AWT.Inputs.Gamepads.Mappings;

awt: Add comment in code describing format of gamepad mappings

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  Copyright (C) 2014, 2015 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 MAT.Frames;
with MAT.Events.Probes;
with MAT.Memory.Tools;
with MAT.Expressions;
package MAT.Memory.Targets is

   --  Define some global statistics about the memory slots.
   type Memory_Stat is record
      Thread_Count  : Natural := 0;
      Total_Alloc   : MAT.Types.Target_Size := 0;
      Total_Free    : MAT.Types.Target_Size := 0;
      Malloc_Count  : Natural := 0;
      Free_Count    : Natural := 0;
      Realloc_Count : Natural := 0;
   end record;

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory  : in out Target_Memory;
                         Manager : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Add the memory region from the list of memory region managed by the program.
   procedure Add_Region (Memory : in out Target_Memory;
                         Region : in Region_Info);

   --  Find the memory region that intersect the given section described by <tt>From</tt>
   --  and <tt>To</tt>.  Each memory region that intersects is added to the <tt>Into</tt>
   --  map.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Into   : in out MAT.Memory.Region_Info_Map);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

   --  Collect the information about frames and the memory allocations they've made.
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map);

   --  Get the global memory and allocation statistics.
   procedure Stat_Information (Memory : in out Target_Memory;
                               Result : out Memory_Stat);

   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map);

private

   protected type Memory_Allocator is

      --  Add the memory region from the list of memory region managed by the program.
      procedure Add_Region (Region : in Region_Info);

      --  Find the memory region that intersect the given section described by <tt>From</tt>
      --  and <tt>To</tt>.  Each memory region that intersects is added to the <tt>Into</tt>
      --  map.
      procedure Find (From : in MAT.Types.Target_Addr;
                      To   : in MAT.Types.Target_Addr;
                      Into : in out MAT.Memory.Region_Info_Map);

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

      --  Collect the information about frames and the memory allocations they've made.
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map);

      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map);

      --  Get the global memory and allocation statistics.
      procedure Stat_Information (Result : out Memory_Stat);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Regions       : Region_Info_Map;
      Stats         : Memory_Stat;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Manager       : MAT.Events.Probes.Probe_Manager_Type_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  Copyright (C) 2014, 2015 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 MAT.Frames;
with MAT.Events.Probes;
with MAT.Memory.Tools;
with MAT.Expressions;
package MAT.Memory.Targets is

   --  Define some global statistics about the memory slots.
   type Memory_Stat is record
      Thread_Count  : Natural := 0;
      Total_Alloc   : MAT.Types.Target_Size := 0;
      Total_Free    : MAT.Types.Target_Size := 0;
      Malloc_Count  : Natural := 0;
      Free_Count    : Natural := 0;
      Realloc_Count : Natural := 0;
   end record;

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory  : in out Target_Memory;
                         Manager : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Add the memory region from the list of memory region managed by the program.
   procedure Add_Region (Memory : in out Target_Memory;
                         Region : in Region_Info);

   --  Find the memory region that intersect the given section described by <tt>From</tt>
   --  and <tt>To</tt>.  Each memory region that intersects is added to the <tt>Into</tt>
   --  map.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Into   : in out MAT.Memory.Region_Info_Map);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in out Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

   --  Collect the information about frames and the memory allocations they've made.
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map);

   --  Get the global memory and allocation statistics.
   procedure Stat_Information (Memory : in out Target_Memory;
                               Result : out Memory_Stat);

   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map);

private

   protected type Memory_Allocator is

      --  Add the memory region from the list of memory region managed by the program.
      procedure Add_Region (Region : in Region_Info);

      --  Find the memory region that intersect the given section described by <tt>From</tt>
      --  and <tt>To</tt>.  Each memory region that intersects is added to the <tt>Into</tt>
      --  map.
      procedure Find (From : in MAT.Types.Target_Addr;
                      To   : in MAT.Types.Target_Addr;
                      Into : in out MAT.Memory.Region_Info_Map);

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in out Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

      --  Collect the information about frames and the memory allocations they've made.
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map);

      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map);

      --  Get the global memory and allocation statistics.
      procedure Stat_Information (Result : out Memory_Stat);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Regions       : Region_Info_Map;
      Stats         : Memory_Stat;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Manager       : MAT.Events.Probes.Probe_Manager_Type_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

Change the Slot parameter of Probe_Free to an in out parameter