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 :

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 » :

Cordialement,
Stéphane

L	M	M	J	V	S	D
				1	2	3
4	5	6	7	8	9	10
11	12	13	14	15	16	17
18	19	20	21	22	23	24
25	26	27	28	29	30

S(O)LOIST

A4A : Infrastructure Messagerie Hilscher cifX – Layer 2

Stéphane LOS – Informatique Scientifique et Technique