Archives de catégorie : Ada4Automation

« Ada for Automation » est un cadriciel pour développer des applications d’automatisme évoluées dans le langage Ada.

Ada4Automation, cifX, comX, netJACK

A4A : Infrastructure Messagerie Hilscher cifX – Layer 2

Bonjour,

Dans une application faisant un usage normal, voire intensif de la messagerie Hilscher, on peut éviter d’allouer puis libérer continuellement des paquets en utilisant un réservoir (Pool) de paquets.

Ce réservoir de paquets est implémenté dans le paquetage générique « A4A.Protocols.HilscherX.Message_Pool ».
On met en œuvre un type protégé qui autorise une utilisation par plusieurs tâches du Pool.

Ainsi, on instancie ce paquetage générique avec la taille souhaitée, on l’initialise avec la procédure idoine puis on peut obtenir un accès sur un paquet avec la procédure « Get_Packet », on s’en sert et enfin on le retourne au Pool avec la procédure « Return_Packet ». Si tous les paquets sont en cours d’utilisation on attend son tour.

Il est également souhaitable d’utiliser des queues pour gérer les flux de messages en émission comme en réception.
Le paquetage générique « A4A.Protocols.HilscherX.Message_Queue » constitue une implémentation possible d’une FIFO, aussi sous la forme d’un type protégé.

On pourra utiliser ces queues entre les objets initiateurs des requêtes et la tâche gérant l’émission ou entre la tâche de réception et les objets destinataires des réponses ou indications.

Après instanciation de ce paquetage, il est possible d’insérer dans la queue un paquet, ou plutôt une référence à ce paquet, avec la procédure « Put » (qui indique si cela a pu être réalisé ou pas – la queue est pleine).

On peut interroger la queue avec la procédure « Get », qui indique si la queue est vide le cas échéant, ou avec l’entrée « Get » qui permet une mise en attente de la tâche appelante si la queue est vide. La procédure est normalement utilisée par les objets en attente de réponse car elle est non bloquante.

Un exemple d’une telle infrastructure est fourni par le paquetage « A4A.Protocols.HilscherX.Messaging » dont la spécification est :

-----------------------------------------------------------------------
--                       Ada for Automation                          --
--                                                                   --
--              Copyright (C) 2012-2014, Stephane LOS                --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This library is distributed in the hope that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-----------------------------------------------------------------------

-- <summary>
-- This package provides the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - messaging infrastructure.
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>

with A4A.Protocols.HilscherX.cifX_Errors;
use A4A.Protocols.HilscherX.cifX_Errors;

with A4A.Protocols.HilscherX.cifX_User;
use A4A.Protocols.HilscherX.cifX_User;

with A4A.Protocols.HilscherX.Message_Queue;
with A4A.Protocols.HilscherX.Message_Pool;

package A4A.Protocols.HilscherX.Messaging is

   procedure Quit;
   procedure Initialise (Channel_Handle : in Channel_Handle_Type);

   package Pool_Package is new
     A4A.Protocols.HilscherX.Message_Pool (Pool_Size => 20);

   Message_Pool : Pool_Package.Message_Pool_Type;

   package Queue_Package is new
     A4A.Protocols.HilscherX.Message_Queue (Queue_Size => 10);

   Send_Queue : Queue_Package.Message_Queue_Type;
   Receive_Queue : Queue_Package.Message_Queue_Type;

   task Send_Msg;

   task Receive_Msg;

private

   Quit_Flag : Boolean := False;
   Init_Flag : Boolean := False;

   The_Channel_Handle : Channel_Handle_Type;

end A4A.Protocols.HilscherX.Messaging;

On y trouve :

  • L’instanciation du paquetage « réservoir de paquets » et la déclaration du pool
  • L’instanciation du paquetage « queue de paquets » et la déclaration des queues d’émission et réception
  • La déclaration des deux tâches d’émission et réception

Le code de l’application de test est montré ci-dessous qui réalise la même opération que dans l’article précédent mais en utilisant bien sûr cette infrastructure :

-----------------------------------------------------------------------
--                       Ada for Automation                          --
--                                                                   --
--              Copyright (C) 2012-2014, Stephane LOS                --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This library is distributed in the hope that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-----------------------------------------------------------------------


with Ada.Text_IO;

with Interfaces.C;

with Ada.Exceptions; use Ada.Exceptions;

with A4A; use A4A;

with A4A.Protocols.HilscherX.cifX_Errors;
use A4A.Protocols.HilscherX.cifX_Errors;

with A4A.Protocols.HilscherX.cifX_User;

with A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify;
use A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify;

with A4A.Protocols.HilscherX.Messaging;
use A4A.Protocols.HilscherX;

procedure Test_Messaging is

   package cifX renames A4A.Protocols.HilscherX.cifX_User;

   Driver_Handle  : aliased cifX.Driver_Handle_Type;
   Channel_Handle : aliased cifX.Channel_Handle_Type;

   Result : DInt;

   Request      : cifX.cifX_Packet_Access;
   Confirmation : cifX.cifX_Packet_Access;

   cifX_Driver_Init_Done  : Boolean := False;
   cifX_Driver_Open_Done  : Boolean := False;
   cifX_Channel_Open_Done : Boolean := False;

   Fw_Ident_Req : RCX_FIRMWARE_IDENTIFY_REQ_T_Access;
   Fw_Ident_Cnf : RCX_FIRMWARE_IDENTIFY_CNF_T_Access;

   Packet_Got : Boolean := False;
   Packet_Put : Boolean := False;

   procedure cifX_Show_Firmware_Identification is
      What : String := CRLF
        & "***********************************************" & CRLF
        & "          Firmware Identification" & CRLF & CRLF
        & "Firmware Version :" & CRLF
        & "Major    : "
        & Fw_Ident_Cnf.Data.Fw_Identification.Fw_Version.Major'Img & CRLF
        & "Minor    : "
        & Fw_Ident_Cnf.Data.Fw_Identification.Fw_Version.Minor'Img & CRLF
        & "Build    : "
        & Fw_Ident_Cnf.Data.Fw_Identification.Fw_Version.Build'Img & CRLF
        & "Revision : "
        & Fw_Ident_Cnf.Data.Fw_Identification.Fw_Version.Revision'Img & CRLF
        & CRLF
        & "Firmware Name : "
        & Interfaces.C.To_Ada
        (Fw_Ident_Cnf.Data.Fw_Identification.Fw_Name.Name) & CRLF
        & CRLF
        & "Firmware Date :" & CRLF
        & "Year  : "
        & Fw_Ident_Cnf.Data.Fw_Identification.Fw_Date.Year'Img & CRLF
        & "Month : "
        & Fw_Ident_Cnf.Data.Fw_Identification.Fw_Date.Month'Img & CRLF
        & "Day   : "
        & Fw_Ident_Cnf.Data.Fw_Identification.Fw_Date.Day'Img & CRLF
        & "***********************************************" & CRLF;
   begin
      Ada.Text_IO.Put_Line (What);
   end cifX_Show_Firmware_Identification;

   procedure Close is
   begin

      Messaging.Quit;

      delay 5.0;

      if cifX_Channel_Open_Done then
         Ada.Text_IO.Put_Line (Item => "Closing Channel");
         Result := cifX.Channel_Close (Channel_Handle);
         if Result /= CIFX_NO_ERROR then
            cifX.Show_Error(Result);
         end if;
         cifX_Channel_Open_Done := False;
      end if;

      if cifX_Driver_Open_Done then
         Ada.Text_IO.Put_Line (Item => "Closing Driver");
         Result := cifX.Driver_Close (Driver_Handle);
         if Result /= CIFX_NO_ERROR then
            cifX.Show_Error(Result);
         end if;
         cifX_Driver_Open_Done := False;
      end if;

      if cifX_Driver_Init_Done then
         Ada.Text_IO.Put_Line (Item => "Deinitializing cifX Driver");
         cifX.Driver_Deinit;
         cifX_Driver_Init_Done := False;
      end if;

   end Close;

begin

   Ada.Text_IO.Put_Line (Item => "Test_Messaging...");

   Ada.Text_IO.Put_Line (Item => "Initializing cifX Driver");
   Result := cifX.Driver_Init;
   if Result /= CIFX_NO_ERROR then
      cifX.Show_Error(Result);
   else
      cifX_Driver_Init_Done := True;
   end if;

   if cifX_Driver_Init_Done then

      Ada.Text_IO.Put_Line (Item => "Opening Driver");
      Result := cifX.Driver_Open (Driver_Handle'Access);
      if Result /= CIFX_NO_ERROR then
         cifX.Show_Error(Result);
      else
         cifX_Driver_Open_Done := True;
      end if;

   end if;

   if cifX_Driver_Open_Done then

      Ada.Text_IO.Put_Line (Item => "Opening Channel");
      Result := cifX.Channel_Open
        (Driver_Handle          => Driver_Handle,
         Board_Name             => "cifX0",
         Channel_Number         => 0,
         Channel_Handle_Access  => Channel_Handle'Access);

      if Result /= CIFX_NO_ERROR then
         cifX.Show_Error(Result);
      else
         cifX_Channel_Open_Done := True;
      end if;

   end if;

   if cifX_Channel_Open_Done then

      Messaging.Initialise (Channel_Handle => Channel_Handle);

      Ada.Text_IO.Put_Line (Item => "Sending Request");

      Messaging.Message_Pool.Get_Packet
        (Item   => Request,
         Result => Packet_Got);

      if not Packet_Got then

         Ada.Text_IO.Put_Line
           ("Could not get Request packet from pool...");

      else

         Fw_Ident_Req := From_cifX_Packet (Request);

         Fw_Ident_Req.Head.Dest    := 16#20#;
         Fw_Ident_Req.Head.Src     := 0;
         Fw_Ident_Req.Head.Dest_Id := 0;
         Fw_Ident_Req.Head.Src_Id  := 0;
         Fw_Ident_Req.Head.Len     := 4;
         Fw_Ident_Req.Head.Id      := 1;
         Fw_Ident_Req.Head.State   := 0;
         Fw_Ident_Req.Head.Cmd     := RCX_FIRMWARE_IDENTIFY_REQ;
         Fw_Ident_Req.Head.Ext     := 0;
         Fw_Ident_Req.Head.Rout    := 0;

         Fw_Ident_Req.Data.Channel_Id := 0;

         Messaging.Send_Queue.Put
           (Item   => Request,
            Result => Packet_Put);

         if not Packet_Put then

            Ada.Text_IO.Put_Line
              ("Could not put Request packet in queue...");

            Messaging.Message_Pool.Return_Packet (Item => Request);

         else

            Messaging.Receive_Queue.Get (Item => Confirmation);

            Fw_Ident_Cnf := From_cifX_Packet (Confirmation);

            cifX_Show_Firmware_Identification;

            Messaging.Message_Pool.Return_Packet (Item => Confirmation);

         end if;

      end if;

   end if;

   Close;

exception

   when Error: others =>
      Ada.Text_IO.Put_Line (Exception_Information(Error));

      Close;

end Test_Messaging;

Avec un peu de chance ça tombe en marche et la trace est présentée ci-bas :

C:\GNAT\Projects\A4A\hilscherx\exe\test_messaging
Test_Messaging...
Initializing cifX Driver
Opening Driver
Opening Channel
Sending Request

***********************************************
          Firmware Identification

Firmware Version :
Major    :  2
Minor    :  6
Build    :  7
Revision :  1

Firmware Name : EtherNet/IP Scanner

Firmware Date :
Year  :  2013
Month :  12
Day   :  3
***********************************************

Closing Channel
Closing Driver
Deinitializing cifX Driver

[2014-06-11 11:19:03] process terminated successfully, elapsed time: 06.53s

De leur côté, les tâches d’émission et de réception s’exécutent parallèlement au fil du programme principal.

La tâche d’émission bloque sur l’attente d’un message dans la queue d’émission et retourne le paquet émis au pool.

La tâche de réception obtient un paquet du pool puis boucle en attente de réception d’un paquet et poste le paquet reçu dans la queue de réception.

Voilà le corps du paquetage « A4A.Protocols.HilscherX.Messaging » :

-----------------------------------------------------------------------
--                       Ada for Automation                          --
--                                                                   --
--              Copyright (C) 2012-2014, Stephane LOS                --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This library is distributed in the hope that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-----------------------------------------------------------------------

-- <summary>
-- This package provides the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - messaging infrastructure.
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>

with Ada.Text_IO;

package body A4A.Protocols.HilscherX.Messaging is

   procedure Quit is
   begin
      Quit_Flag := True;
   end Quit;

   procedure Initialise
     (Channel_Handle : in Channel_Handle_Type) is
   begin

      The_Channel_Handle := Channel_Handle;

      Message_Pool.Initialise;

      Init_Flag := True;

   end Initialise;

   task body Send_Msg is

      Packet    : cifX_Packet_Access;

      Result    : DInt;

   begin

      loop

         delay 1.0;
         exit when Init_Flag or Quit_Flag;

      end loop;

      loop

         exit when Quit_Flag;

         select

            Send_Queue.Get (Item => Packet);

            Result := Channel_Put_Packet
              (Channel_Handle => The_Channel_Handle,
               Send_Packet    => Packet.all,
               Time_Out       => 10);
            if Result /= CIFX_NO_ERROR then
               Show_Error (Result);
            end if;

            Message_Pool.Return_Packet (Item => Packet);

         or

            delay 1.0;

         end select;

      end loop;

   end Send_Msg;

   task body Receive_Msg is

      Packet     : cifX_Packet_Access;

      Result     : DInt;

      Packet_Got : Boolean := False;
      Packet_Put : Boolean := False;

   begin

      loop

         delay 1.0;
         exit when Init_Flag or Quit_Flag;

      end loop;

      loop

         exit when Quit_Flag;

         if not Packet_Got then

            Message_Pool.Get_Packet
              (Item   => Packet,
               Result => Packet_Got);

         end if;

         if not Packet_Got then

            Ada.Text_IO.Put_Line
              ("Receive_Msg : Could not get packet from pool...");

         else

            Result := Channel_Get_Packet
              (Channel_Handle => The_Channel_Handle,
               Size           => cifX_Packet_Type'Size / 8,
               Recv_Packet    => Packet.all,
               Time_Out       => 1000);
            if Result = CIFX_NO_ERROR then

               Receive_Queue.Put
                 (Item   => Packet,
                  Result => Packet_Put);

               Packet_Got := False;

            elsif Result = CIFX_DEV_GET_TIMEOUT
              or Result = CIFX_DEV_GET_NO_PACKET then

               Ada.Text_IO.Put_Line
                 ("Zut !");

            else

               Show_Error (Result);

            end if;

         end if;

      end loop;

   end Receive_Msg;

end A4A.Protocols.HilscherX.Messaging;

Cordialement,
Stéphane