-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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 Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;

with System;

with Util.Properties;
with Util.Streams.Buffered;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out Message) is abstract;
   --  Dispatch the message

--     procedure Bind (For_Servant : in out Reader_Base) is abstract;
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.  This is called once we have all the
   --  information about the structures of events that we can
   --  receive.

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is abstract tagged limited private;
   type Manager is access all Manager_Base'Class;

   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access);

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message);

   --  Read a message from the stream.
   procedure Read_Message (Client : in out Manager_Base;
                           Msg    : in out Message) is abstract;

   --  Read a list of event definitions from the stream and configure the reader.
   procedure Read_Event_Definitions (Client : in out Manager_Base;
                                     Msg    : in out Message);

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Buffer  : Util.Streams.Buffered.Buffer_Access;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
      Attributes  : MAT.Events.Const_Attribute_Table_Access;
      Mapping     : MAT.Events.Attribute_Table_Ptr;
   end record;

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint16;

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

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Types.Uint16,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is abstract tagged limited record
      Readers     : Reader_Maps.Map;
      Handlers    : Handler_Maps.Map;
      Version     : MAT.Types.Uint16;
      Flags       : MAT.Types.Uint16;
      Probe       : MAT.Events.Attribute_Table_Ptr;
      Frame       : access MAT.Events.Frame_Info;
   end record;

   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message);

   --  Read an event definition from the stream and configure the reader.
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message);

end MAT.Readers;

-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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 Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;

with System;

with Util.Properties;
with Util.Streams.Buffered;

with MAT.Types;
with MAT.Events;
with MAT.Events.Targets;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out Message) is abstract;

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is abstract tagged limited private;
   type Manager is access all Manager_Base'Class;

   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access);

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message);

   --  Read a message from the stream.
   procedure Read_Message (Client : in out Manager_Base;
                           Msg    : in out Message) is abstract;

   --  Read a list of event definitions from the stream and configure the reader.
   procedure Read_Event_Definitions (Client : in out Manager_Base;
                                     Msg    : in out Message);

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Buffer  : Util.Streams.Buffered.Buffer_Access;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
      Attributes  : MAT.Events.Const_Attribute_Table_Access;
      Mapping     : MAT.Events.Attribute_Table_Ptr;
   end record;

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint16;

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

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Types.Uint16,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is abstract tagged limited record
      Readers     : Reader_Maps.Map;
      Handlers    : Handler_Maps.Map;
      Version     : MAT.Types.Uint16;
      Flags       : MAT.Types.Uint16;
      Probe       : MAT.Events.Attribute_Table_Ptr;
      Frame       : access MAT.Events.Frame_Info;
      Events      : MAT.Events.Targets.Target_Events_Access;
   end record;

   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message);

   --  Read an event definition from the stream and configure the reader.
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message);

end MAT.Readers;

Add the Events access member in Manager_Base to track events


-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  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.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;
with Ada.Finalization;

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Frames.Targets;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
with MAT.Expressions;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  The library search path.
      Search_Path  : Ada.Strings.Unbounded.Unbounded_String;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Expressions.Resolver_Type with record
      Pid     : MAT.Types.Target_Process_Ref;
      Endian  : MAT.Readers.Endian_Type := MAT.Readers.LITTLE_ENDIAN;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Frames  : MAT.Frames.Targets.Target_Frames_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   --  Release the target process instance.
   overriding
   procedure Finalize (Target : in out Target_Process_Type);

   --  Find the region that matches the given name.
   overriding
   function Find_Region (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Find the symbol in the symbol table and return the start and end address.
   overriding
   function Find_Symbol (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Get the start time for the tick reference.
   overriding
   function Get_Start_Time (Resolver : in Target_Process_Type)
                            return MAT.Types.Target_Tick_Ref;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Add a search path for the library and symbol loader.
   procedure Add_Search_Path (Target : in out MAT.Targets.Target_Type;
                              Path   : in String);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

   --  Release the storage used by the target object.
   overriding
   procedure Finalize (Target : in out Target_Type);

end MAT.Targets;

-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  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.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;
with Ada.Finalization;

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Frames.Targets;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
with MAT.Expressions;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  The library search path.
      Search_Path  : Ada.Strings.Unbounded.Unbounded_String;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4606, others => <>);
   end record;

   type Target_Process_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Expressions.Resolver_Type with record
      Pid     : MAT.Types.Target_Process_Ref;
      Endian  : MAT.Readers.Endian_Type := MAT.Readers.LITTLE_ENDIAN;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Frames  : MAT.Frames.Targets.Target_Frames_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   --  Release the target process instance.
   overriding
   procedure Finalize (Target : in out Target_Process_Type);

   --  Find the region that matches the given name.
   overriding
   function Find_Region (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Find the symbol in the symbol table and return the start and end address.
   overriding
   function Find_Symbol (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Get the start time for the tick reference.
   overriding
   function Get_Start_Time (Resolver : in Target_Process_Type)
                            return MAT.Types.Target_Tick_Ref;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Add a search path for the library and symbol loader.
   procedure Add_Search_Path (Target : in out MAT.Targets.Target_Type;
                              Path   : in String);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

   --  Release the storage used by the target object.
   overriding
   procedure Finalize (Target : in out Target_Type);

end MAT.Targets;

Change the default port to 4606

Change the default port to 4606


-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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.Log.Loggers;

with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

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

   procedure Read_Probe (Client : in out Manager_Base;
                         Msg    : in out Message);

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Manager_Base) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
   end Initialize;

   --  ------------------------------
   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Manager_Base)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Manager_Base;
                         Msg    : in out Message) is
      use type Interfaces.Unsigned_64;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : constant access MAT.Events.Frame_Info := Client.Frame;
   begin
      Frame.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_ID =>
                  Frame.Thread := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Count loop
                     if Count < Frame.Depth then
                        Frame.Frame (I) := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      Frame.Time := Interfaces.Shift_Left (Interfaces.Unsigned_64 (Time_Sec), 32);
      Frame.Time := Frame.Time or Interfaces.Unsigned_64 (Time_Usec);
      Frame.Cur_Depth := Count;
   end Read_Probe;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      Log.Debug ("Dispatch message {0} - size {1}",
                 MAT.Types.Uint16'Image (Event),
                 Natural'Image (Msg.Size));

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Events.Insert (Event, Client.Frame.all);
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access,
                      Client.Frame.all, Msg);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);
      Frame : Message_Handler;

      procedure Add_Handler (Key     : in String;
                             Element : in out Message_Handler);

      procedure Add_Handler (Key     : in String;
                             Element : in out Message_Handler) is
         pragma Unreferenced (Key);
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler) is
               pragma Unreferenced (Key);
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Reader_Maps.Has_Element (Pos) then
               Client.Readers.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Reader_Maps.Has_Element (Pos) then
         Client.Readers.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Manager_Base;
                                     Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

   --  ------------------------------
   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   --  ------------------------------
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
   begin
      Client.Read_Event_Definitions (Msg);

      Client.Frame := new MAT.Events.Frame_Info (512);
   exception
         when E : others =>
         Log.Error ("Exception while reading headers ", E);
   end Read_Headers;

end MAT.Readers;

-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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.Log.Loggers;

with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

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

   procedure Read_Probe (Client : in out Manager_Base;
                         Msg    : in out Message);

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Manager_Base) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
   end Initialize;

   --  ------------------------------
   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Manager_Base)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Manager_Base;
                         Msg    : in out Message) is
      use type Interfaces.Unsigned_64;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : constant access MAT.Events.Frame_Info := Client.Frame;
   begin
      Frame.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_ID =>
                  Frame.Thread := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer, Def.Kind);

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg.Buffer,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Count loop
                     if Count < Frame.Depth then
                        Frame.Frame (I) := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      Frame.Time := Interfaces.Shift_Left (Interfaces.Unsigned_64 (Time_Sec), 32);
      Frame.Time := Frame.Time or Interfaces.Unsigned_64 (Time_Usec);
      Frame.Cur_Depth := Count;
   end Read_Probe;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Log.Get_Level = Util.Log.DEBUG_LEVEL then
         Log.Debug ("Dispatch message {0} - size {1}",
                    MAT.Types.Uint16'Image (Event),
                    Natural'Image (Msg.Size));
      end if;

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Events.Insert (Event, Client.Frame.all);
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access,
                      Client.Frame.all, Msg);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);
      Frame : Message_Handler;

      procedure Add_Handler (Key     : in String;
                             Element : in out Message_Handler);

      procedure Add_Handler (Key     : in String;
                             Element : in out Message_Handler) is
         pragma Unreferenced (Key);
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Message_Handler) is
               pragma Unreferenced (Key);
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Reader_Maps.Has_Element (Pos) then
               Client.Readers.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Reader_Maps.Has_Element (Pos) then
         Client.Readers.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Manager_Base;
                                     Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

   --  ------------------------------
   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   --  ------------------------------
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
   begin
      Client.Read_Event_Definitions (Msg);

      Client.Frame := new MAT.Events.Frame_Info (512);
   exception
         when E : others =>
         Log.Error ("Exception while reading headers ", E);
   end Read_Headers;

end MAT.Readers;

Check the log level before doing the Log.Debug to avoid formatting some event type and message size for nothing


-----------------------------------------------------------------------
--  monitor - A simple monitor API
--  Copyright (C) 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 ASF.Responses;
with ASF.Rest.Definition;
package body Monitor is

   type Monitor_Array is array (1 .. MAX_MONITOR) of Monitor_Data;

   Monitors : Monitor_Array;

   --  Get values of the monitor.
   procedure Get_Values (D : in out Mon;
                         Req    : in out ASF.Rest.Request'Class;
                         Reply  : in out ASF.Rest.Response'Class;
                         Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
   begin
      Pos := Positive'Value (Id);
      Monitors (Pos).Put (0);
      declare
         Values : constant Value_Array := Monitors (Pos).Get_Values;
      begin
         Stream.Start_Document;
         Stream.Start_Array ("values");
         for V of Values loop
            Stream.Write_Long_Entity ("value", Long_Long_Integer (V));
         end loop;
         Stream.End_Array ("values");
         Stream.End_Document;
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Get_Values;

   --  PUT /mon/:id
   procedure Put_Value (D : in out Mon;
                        Req    : in out ASF.Rest.Request'Class;
                        Reply  : in out ASF.Rest.Response'Class;
                        Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
      Val : Natural;
   begin
      Pos := Positive'Value (Id);
      begin
         Val := Natural'Value (Req.Get_Parameter ("value"));
         Monitors (Pos).Put (Val);

      exception
         when others =>
            Reply.Set_Status (ASF.Responses.SC_BAD_REQUEST);
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Put_Value;

   protected body Monitor_Data is

      procedure Put (Value : in Natural) is
         use type Ada.Calendar.Time;

         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
         Dt  : constant Duration := Now - Slot_Start;
         Cnt : Natural := Natural (Dt / Slot_Size);
      begin
         while Cnt > 0 loop
            Cnt := Cnt - 1;
            Pos := Pos + 1;
            if Pos > Values'Last then
               Pos := Values'First;
               Value_Count := Values'Length;
            elsif Value_Count < Values'Length then
               Value_Count := Value_Count + 1;
            end if;
         end loop;
         Values (Pos) := Value;
      end Put;

      procedure Put (Value : in Natural; Slot : in Natural) is
      begin
         null;
      end Put;

      function Get_Values return Value_Array is
         Result : Value_Array (1 .. Value_Count);
         Cnt    : Natural;
         N      : Natural;
      begin
         if Value_Count = Values'Length then
            Cnt := Values'Length - Pos + 1;
         else
            Cnt := 0;
         end if;
         if Cnt > 0 then
            Result (1 .. Cnt) := Values (Pos + 1 .. Pos + 1 + Cnt - 1);
            N := Cnt + 1;
         else
            N := 1;
         end if;
         if Value_Count = Values'Length then
            Cnt := Pos;
         else
            Cnt := Pos - 1;
         end if;
         if Cnt > 0 then
            Result (N .. N + Cnt - 1) := Values (1 .. Cnt);
         end if;
         return Result;
      end Get_Values;

   end Monitor_Data;

end Monitor;

-----------------------------------------------------------------------
--  monitor - A simple monitor API
--  Copyright (C) 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 ASF.Responses;
with ASF.Rest.Definition;
package body Monitor is

   type Monitor_Array is array (1 .. MAX_MONITOR) of Monitor_Data;

   Monitors : Monitor_Array;

   --  Get values of the monitor.
   procedure Get_Values (D : in out Mon;
                         Req    : in out ASF.Rest.Request'Class;
                         Reply  : in out ASF.Rest.Response'Class;
                         Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
   begin
      Pos := Positive'Value (Id);
      --  Monitors (Pos).Put (0);

      --  Get the monitor values.
      declare
         Values : constant Value_Array := Monitors (Pos).Get_Values;
      begin

         --  Write the JSON/XML document.
         Stream.Start_Document;
         Stream.Start_Array ("values");
         for V of Values loop
            Stream.Write_Long_Entity ("value", Long_Long_Integer (V));
         end loop;
         Stream.End_Array ("values");
         Stream.End_Document;
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Get_Values;

   --  PUT /mon/:id
   procedure Put_Value (D : in out Mon;
                        Req    : in out ASF.Rest.Request'Class;
                        Reply  : in out ASF.Rest.Response'Class;
                        Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
      Val : Natural;
   begin
      Pos := Positive'Value (Id);
      begin
         Val := Natural'Value (Req.Get_Parameter ("value"));
         Monitors (Pos).Put (Val);

      exception
         when others =>
            Reply.Set_Status (ASF.Responses.SC_BAD_REQUEST);
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Put_Value;

   protected body Monitor_Data is

      procedure Put (Value : in Natural) is
         use type Ada.Calendar.Time;

         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
         Dt  : constant Duration := Now - Slot_Start;
         Cnt : Natural := Natural (Dt / Slot_Size);
      begin
         if Cnt > 0 then
            while Cnt > 0 loop
               Cnt := Cnt - 1;
               Pos := Pos + 1;
               if Pos > Values'Last then
                  Pos := Values'First;
                  Value_Count := Values'Length;
               elsif Value_Count < Values'Length then
                  Value_Count := Value_Count + 1;
               end if;
               Slot_Start := Slot_Start + Slot_Size;
            end loop;
         end if;
         Values (Pos) := Value;
      end Put;

      procedure Put (Value : in Natural; Slot : in Natural) is
      begin
         null;
      end Put;

      function Get_Values return Value_Array is
         Result : Value_Array (1 .. Value_Count);
         Cnt    : Natural;
         N      : Natural;
      begin
         if Value_Count = Values'Length then
            Cnt := Values'Last - Pos;
         else
            Cnt := 0;
         end if;
         if Cnt > 0 then
            Result (1 .. Cnt) := Values (Pos + 1 .. Pos + 1 + Cnt - 1);
            N := Cnt + 1;
         else
            N := 1;
         end if;
         if Value_Count = Values'Length then
            Cnt := Pos;
         else
            Cnt := Pos - 1;
         end if;
         if Cnt > 0 then
            Result (N .. N + Cnt - 1) := Values (1 .. Cnt);
         end if;
         return Result;
      end Get_Values;

   end Monitor_Data;

end Monitor;

Update the monitor implementation, fix Get_Values implementation


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2016 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 Interfaces.C;

package Orka is
   pragma Pure;

   type Index_Homogeneous is (X, Y, Z, W);

   subtype Index_2D is Index_Homogeneous range X .. Y;
   subtype Index_3D is Index_Homogeneous range X .. Z;

   ----------------------------------------------------------------------------

   type Integer_16 is new Interfaces.C.short;
   type Integer_32 is new Interfaces.C.int;

   type Integer_64 is range -(2 ** 63) .. +(2 ** 63 - 1);
   --  Based on C99 long long int

   type Unsigned_32 is mod 2 ** 32
     with Size => 32;

   type Unsigned_64 is mod 2 ** 64
     with Size => 64;
   --  Based on C99 unsigned long long int

   subtype Float_16 is Integer_16;
   --  F16C extension can be used to convert from/to Single

   type Float_32 is new Interfaces.C.C_float;
   type Float_64 is new Interfaces.C.double;

   ----------------------------------------------------------------------------

   type Time is private;

   function "-" (Left, Right : Time) return Duration;
   function "-" (Left : Time; Right : Duration) return Time;

private

   type Time is new Duration;

   function "-" (Left, Right : Time) return Duration is (Duration (Left) - Duration (Right));

   function "-" (Left : Time; Right : Duration) return Time is (Time (Duration (Left) - Right));

end Orka;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2016 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 Interfaces.C;

package Orka is
   pragma Pure;

   type Index_Homogeneous is (X, Y, Z, W);

   subtype Index_2D is Index_Homogeneous range X .. Y;
   subtype Index_3D is Index_Homogeneous range X .. Z;

   ----------------------------------------------------------------------------

   type Integer_16 is new Interfaces.C.short;
   type Integer_32 is new Interfaces.C.int;

   type Integer_64 is range -(2 ** 63) .. +(2 ** 63 - 1);
   --  Based on C99 long long int

   type Unsigned_32 is mod 2 ** 32
     with Size => 32;

   type Unsigned_64 is mod 2 ** 64
     with Size => 64;
   --  Based on C99 unsigned long long int

   subtype Float_16 is Integer_16;
   --  F16C extension can be used to convert from/to Single

   type Float_32 is new Interfaces.C.C_float;
   type Float_64 is new Interfaces.C.double;

   overriding
   function "=" (Left, Right : Float_32) return Boolean;

   overriding
   function "=" (Left, Right : Float_64) return Boolean;

   ----------------------------------------------------------------------------

   type Time is private;

   function "-" (Left, Right : Time) return Duration;
   function "-" (Left : Time; Right : Duration) return Time;

private

   overriding
   function "=" (Left, Right : Float_32) return Boolean is
     (abs (Left - Right) <= Float_32'Model_Epsilon);

   overriding
   function "=" (Left, Right : Float_64) return Boolean is
     (abs (Left - Right) <= Float_64'Model_Epsilon);

   type Time is new Duration;

   function "-" (Left, Right : Time) return Duration is (Duration (Left) - Duration (Right));

   function "-" (Left : Time; Right : Duration) return Time is (Time (Duration (Left) - Right));

end Orka;

orka: Handle model epsilon in '=' operator for floating-point types

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


--  The MIT License (MIT)

--  Copyright (c) 2015 Pavel Zhukov <landgraf@fedoraproject.org>

--  Permission is hereby granted, free of charge, to any person obtaining a copy
--  of this software and associated documentation files (the "Software"), to deal
--  in the Software without restriction, including without limitation the rights
--  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
--  copies of the Software, and to permit persons to whom the Software is
--  furnished to do so, subject to the following conditions:

--  The above copyright notice and this permission notice shall be included in all
--  copies or substantial portions of the Software.

--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
--  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
--  SOFTWARE.

package Nanomsg.Survey is
   Nn_Proto_Survey : constant            := 6;
   Nn_Surveyor     : constant Protocol_T := Nn_Proto_Survey * 16 + 0;
   Nn_respondent   : constant Protocol_T := Nn_Proto_Survey * 16 + 1;
   Nn_Surveyor_Deadline : constant := 1;
end Nanomsg.Survey;

--  The MIT License (MIT)

--  Copyright (c) 2015 Pavel Zhukov <landgraf@fedoraproject.org>

--  Permission is hereby granted, free of charge, to any person obtaining a copy
--  of this software and associated documentation files (the "Software"), to deal
--  in the Software without restriction, including without limitation the rights
--  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
--  copies of the Software, and to permit persons to whom the Software is
--  furnished to do so, subject to the following conditions:

--  The above copyright notice and this permission notice shall be included in all
--  copies or substantial portions of the Software.

--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
--  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
--  SOFTWARE.

package Nanomsg.Survey is
   Nn_Proto_Survey : constant            := 6;
   Nn_Surveyor     : constant Protocol_T := Nn_Proto_Survey * 16 + 2;
   Nn_respondent   : constant Protocol_T := Nn_Proto_Survey * 16 + 3;
   Nn_Surveyor_Deadline : constant := 1;
end Nanomsg.Survey;

Fix survey protocol (Fix #1)

Fix survey protocol (Fix #1)


-----------------------------------------------------------------------
--  babel-Streams-xz -- XZ/LZMA stream management
--  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.
-----------------------------------------------------------------------

private with Lzma.Base;

--  == Compression and Decompression Stream ==
--  The <tt>Babel.Streams.XZ</tt> package provides a compression decompression stream on top
--  of the <tt>LZMA</tt> library.
package Babel.Streams.XZ is

   type Stream_Type is new Babel.Streams.Stream_Type with private;
   type Stream_Access is access all Stream_Type'Class;

   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   overriding
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access);

   --  Write the buffer in the data stream.
   overriding
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access);

   --  Flush the data stream.
   overriding
   procedure Flush (Stream : in out Stream_Type);

   --  Close the data stream.
   overriding
   procedure Close (Stream : in out Stream_Type);

   --  Prepare to read again the data stream from the beginning.
   overriding
   procedure Rewind (Stream : in out Stream_Type);

private

   type Stream_Type is new Babel.Streams.Stream_Type with record
      Context : Lzma.Base.lzma_stream := Lzma.Base.LZMA_STREAM_INIT;
      Action  : Lzma.Base.lzma_action := Lzma.Base.LZMA_RUN;
   end record;

end Babel.Streams.XZ;

-----------------------------------------------------------------------
--  babel-Streams-xz -- XZ/LZMA stream management
--  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.
-----------------------------------------------------------------------

private with Lzma.Base;

--  == Compression and Decompression Stream ==
--  The <tt>Babel.Streams.XZ</tt> package provides a compression decompression stream on top
--  of the <tt>LZMA</tt> library.
package Babel.Streams.XZ is

   type Stream_Type is new Babel.Streams.Stream_Type with private;
   type Stream_Access is access all Stream_Type'Class;

   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   overriding
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access);

   --  Write the buffer in the data stream.
   overriding
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access);

   --  Flush the data stream.
   overriding
   procedure Flush (Stream : in out Stream_Type);

   --  Close the data stream.
   overriding
   procedure Close (Stream : in out Stream_Type);

   --  Prepare to read again the data stream from the beginning.
   overriding
   procedure Rewind (Stream : in out Stream_Type);

private

   type Stream_Type is new Babel.Streams.Stream_Type with record
      Input   : Babel.Streams.Stream_Access;
      Output  : Babel.Streams.Stream_Access;
      Context : aliased Lzma.Base.lzma_stream := Lzma.Base.LZMA_STREAM_INIT;
      Action  : Lzma.Base.lzma_action := Lzma.Base.LZMA_RUN;
      Buffer  : Babel.Files.Buffers.Buffer_Access;
   end record;

end Babel.Streams.XZ;

Update the Stream type to store the input/output stream and action state