Archives par mot-clé : Ada

Ada est un langage évolué pour applications critiques.

A4A : Infrastructure Messagerie Hilscher cifX – Layer 3

Bonjour,

Cet étage est celui des objets qui constituent l’interface applicative.

L’automaticien est habitué aux fonctions et blocs fonctions.

Un bloc fonction, ce n’est jamais qu’un objet qui ne propose qu’une seule méthode.
On instancie ce bloc fonction ou l’on crée un bloc de données d’instance et on appelle le bloc en accolant cet appel à l’instance.

Comme il ne propose qu’une seule méthode, l’interface du bloc fonction doit présenter tous les paramètres, commandes et résultats (IN, OUT, IN_OUT), ce qui alourdit très rapidement celle-ci d’autant plus si la représentation est graphique.

Ada dispose de la notion d’objet depuis 1995. On a toujours des données d’instance mais il est possible pour un objet de posséder diverses méthodes comme nous allons le voir.

En fait, on l’a déjà vu avec l’objet « A4A.Protocols.HilscherX.Channel_Messaging » mais celui-ci n’a pas vocation à être utilisé au niveau application.

Dans tous les exemples précédents, nous avons mis en œuvre la requête permettant de lire les informations concernant le firmware de la carte Hilscher cifX.

Pour gérer cette requête il faut un certain nombre de variables, remplir la requête, l’envoyer, attendre la réponse, recevoir et analyser celle-ci.

Encapsulons tout cela dans un objet et nous augmenterons l’abstraction.

C’est ce que réalise le « Function Block » dont la spécification suit « A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB ».

Comme le paquetage contenant notre objet est fils de « A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify » il hérite de ce qui y est défini et peut donc y utiliser à sa guise.

On trouve dans cette spécification la définition de l’interface de notre objet, constituée des quatre procédures et fonctions, ainsi que celle des données d’instance.

La procédure « Initialise » permet d’associer le bloc au canal de communication.

La procédure « Cyclic » doit bien sûr être appelée cycliquement, tout au moins durant l’exécution de la commande, pour actualiser la machine d’état du bloc.

Les fonctions « Get_Last_Error » et « Get_Data » fournissent les données résultat.

-----------------------------------------------------------------------
--                       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 is part of the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - rcX_Public data types
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>


with A4A.Log;

with A4A.Protocols.HilscherX.Channel_Messaging;
use A4A.Protocols.HilscherX;

package A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB is

   type Instance is tagged limited private;
   type Instance_Access is access all Instance;

   procedure Initialise
     (Function_Block : in out Instance;
      Channel_Access : in Channel_Messaging.Instance_Access);

   procedure Cyclic
     (Function_Block : in out Instance;
      Do_Command     : in Boolean;
      Done           : out Boolean;
      Error          : out Boolean);
   
   function Get_Last_Error
     (Function_Block : in Instance) return DWord;
   
   function Get_Data
     (Function_Block : in Instance) return RCX_FW_IDENTIFICATION_T;
   
private

   My_Ident : String :=
     "A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB";
   
   type Block_Status is
     (X00,
      -- Initial
     
      X01,
      -- Get packet from pool
     
      X02,
      -- Fill packet
     
      X03,
      -- Send packet
     
      X04,
      -- Get answer
     
      X05
      -- Done
     );

   type Instance is tagged limited
      record
         
         My_Channel   : Channel_Messaging.Instance_Access;
         
         Status       : Block_Status := X00;
         
         Request      : cifX_Packet_Access;
         Confirmation : cifX_Packet_Access;

         Fw_Ident_Req : RCX_FIRMWARE_IDENTIFY_REQ_T_Access;
         Fw_Ident_Cnf : RCX_FIRMWARE_IDENTIFY_CNF_T_Access;
         
         Message_Id   : DWord := 0;

         Packet_Got   : Boolean := False;
         Packet_Sent  : Boolean := False;
         Answer_Got   : Boolean := False;
         
         My_Receive_Queue : aliased
           Channel_Messaging.Queue_Package_Single.Message_Queue_Type;
         
         Fw_Identification  : RCX_FW_IDENTIFICATION_T;
         
         Error_Flag : Boolean;
         Last_Error : DWord;

      end record;
   
end A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;

Le corps de notre objet dans lequel les méthodes sont implémentées est disponible ci-dessous.

On y trouve dans la fonction cyclique le traitement de la machine d’état.

-----------------------------------------------------------------------
--                       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 is part of the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - rcX_Public data types
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>


package body A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB is

   procedure Initialise
     (Function_Block : in out Instance;
      Channel_Access :Channel_Messaging.Instance_Access) is
   begin

      Function_Block.My_Channel := Channel_Access;

      Function_Block.Status := X00;
      Function_Block.Error_Flag := False;

   end Initialise;

   procedure Cyclic
     (Function_Block : in out Instance;
      Do_Command     : in Boolean;
      Done           : out Boolean;
      Error          : out Boolean) is
   begin

      case Function_Block.Status is

         when X00 =>

            if Do_Command then
               Function_Block.Error_Flag := False;
               Function_Block.Status := X01;
               Function_Block.Message_Id := Function_Block.Message_Id + 1;
            end if;

         when X01 =>

            Function_Block.My_Channel.Get_Packet
              (Item   => Function_Block.Request,
               Result => Function_Block.Packet_Got);

            if Function_Block.Packet_Got then
               Function_Block.Status := X02;
            end if;

         when X02 =>

            Function_Block.Fw_Ident_Req :=
              From_cifX_Packet (Function_Block.Request);

            Function_Block.Fw_Ident_Req.Head.Dest    := 16#20#;

            Function_Block.Fw_Ident_Req.Head.Src     :=
              Channel_Messaging.Queue_Package_Type_Single;

            Function_Block.Fw_Ident_Req.Head.Dest_Id := 0;

            Function_Block.Fw_Ident_Req.Head.Src_Id  :=
              Channel_Messaging.Queue_Package_Single.From_Message_Queue
                (Function_Block.My_Receive_Queue'Unrestricted_Access);

            Function_Block.Fw_Ident_Req.Head.Len     := 4;

            Function_Block.Fw_Ident_Req.Head.Id      :=
              Function_Block.Message_Id;

            Function_Block.Fw_Ident_Req.Head.State   := 0;

            Function_Block.Fw_Ident_Req.Head.Cmd     :=
              RCX_FIRMWARE_IDENTIFY_REQ;

            Function_Block.Fw_Ident_Req.Head.Ext     := 0;
            Function_Block.Fw_Ident_Req.Head.Rout    := 0;

            Function_Block.Fw_Ident_Req.Data.Channel_Id := 0;

            Function_Block.Status := X03;

         when X03 =>

            Function_Block.My_Channel.Send
              (Item   => Function_Block.Request,
               Result => Function_Block.Packet_Sent);

            if Function_Block.Packet_Sent then
               Function_Block.Status := X04;
            end if;

         when X04 =>

            Function_Block.My_Receive_Queue.Get
              (Item   => Function_Block.Confirmation,
               Result => Function_Block.Answer_Got);

            if Function_Block.Answer_Got then

               Function_Block.Fw_Ident_Cnf :=
                 From_cifX_Packet (Function_Block.Confirmation);

               if Function_Block.Fw_Ident_Cnf.Head.Cmd /=
                 RCX_FIRMWARE_IDENTIFY_CNF then

                  Function_Block.Error_Flag := True;

                  A4A.Log.Logger.Put
                    (Who  => My_Ident & ".Cyclic",
                     What => "Wrong Command received");

               elsif Function_Block.Fw_Ident_Cnf.Head.Id /=
                 Function_Block.Message_Id then

                  Function_Block.Error_Flag := True;

                  A4A.Log.Logger.Put
                    (Who  => My_Ident & ".Cyclic",
                     What => "Wrong Message Id received");

               elsif Function_Block.Fw_Ident_Cnf.Head.State /= 0 then

                  Function_Block.Error_Flag := True;

                  Function_Block.Last_Error :=
                    Function_Block.Fw_Ident_Cnf.Head.State;

               else

                  Function_Block.Fw_Identification :=
                    Function_Block.Fw_Ident_Cnf.Data.Fw_Identification;

               end if;

               Function_Block.My_Channel.Return_Packet
                 (Item => Function_Block.Confirmation);

               Function_Block.Status := X05;
            end if;

         when X05 =>

            if not Do_Command then
               Function_Block.Status := X00;
            end if;

      end case;

      Done := (Function_Block.Status = X05);

      Error := Function_Block.Error_Flag;

   end Cyclic;

   function Get_Last_Error
     (Function_Block : in Instance) return DWord is
   begin

      return Function_Block.Last_Error;

   end Get_Last_Error;

   function Get_Data
     (Function_Block : in Instance) return RCX_FW_IDENTIFICATION_T is
   begin

      return Function_Block.Fw_Identification;

   end Get_Data;

end A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;

Le programme exemple « Test_rcX_Firmware_Identify » met à profit notre nouvel objet.

Après les habituelles initialisations, on entre dans une boucle qui simule le traitement cyclique de votre application d’automatisme.

On en sort lorsqu’un résultat ou une erreur sont obtenus et on les affiche puis on termine proprement.

-----------------------------------------------------------------------
--                       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 Interfaces.C;

with Ada.Exceptions; use Ada.Exceptions;

with A4A; use A4A;

with A4A.Log;

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.FB;
use A4A.Protocols.HilscherX.rcX_Public;

with A4A.Protocols.HilscherX.Channel_Messaging;
use A4A.Protocols.HilscherX.Channel_Messaging;

procedure Test_rcX_Firmware_Identify is

   My_Ident : String := "Test_rcX_Firmware_Identify";

   package cifX renames A4A.Protocols.HilscherX.cifX_User;

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

   Result : DInt;

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

   Do_Command    : Boolean := False;
   Command_Done  : Boolean := False;
   Command_Error : Boolean := False;

   My_Channel_Messaging : aliased
     A4A.Protocols.HilscherX.Channel_Messaging.Instance;

   rcX_Firmware_Identify_FB : rcX_Firmware_Identify.FB.Instance;

   Fw_Identification  : rcX_Firmware_Identify.RCX_FW_IDENTIFICATION_T;

   Error_String : String (1.. 20);

   procedure cifX_Show_Error (Error : DInt) is
   begin
      A4A.Log.Logger.Put
        (Who  => My_Ident,
         What => cifX.Driver_Get_Error_Description(Error));
   end cifX_Show_Error;

   procedure cifX_Show_Firmware_Identification is
      What : String := CRLF
        & "***********************************************" & CRLF
        & "          Firmware Identification" & CRLF & CRLF
        & "Firmware Version :" & CRLF
        & "Major    : "
        & Fw_Identification.Fw_Version.Major'Img & CRLF
        & "Minor    : "
        & Fw_Identification.Fw_Version.Minor'Img & CRLF
        & "Build    : "
        & Fw_Identification.Fw_Version.Build'Img & CRLF
        & "Revision : "
        & Fw_Identification.Fw_Version.Revision'Img & CRLF
        & CRLF
        & "Firmware Name : "
        & Interfaces.C.To_Ada
        (Fw_Identification.Fw_Name.Name) & CRLF
        & CRLF
        & "Firmware Date :" & CRLF
        & "Year  : "
        & Fw_Identification.Fw_Date.Year'Img & CRLF
        & "Month : "
        & Fw_Identification.Fw_Date.Month'Img & CRLF
        & "Day   : "
        & Fw_Identification.Fw_Date.Day'Img & CRLF
        & "***********************************************" & CRLF;
   begin
      A4A.Log.Logger.Put (Who  => My_Ident,
                          What => What);
   end cifX_Show_Firmware_Identification;

   procedure Close is
   begin

      My_Channel_Messaging.Quit;

      --Wait for completion
      loop

         exit when My_Channel_Messaging.Is_Terminated;
         delay 1.0;

      end loop;

      if cifX_Channel_Open_Done then
         A4A.Log.Logger.Put (Who  => My_Ident,
                             What => "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
         A4A.Log.Logger.Put (Who  => My_Ident,
                             What => "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
         A4A.Log.Logger.Put (Who  => My_Ident,
                             What => "Deinitializing cifX Driver");
         cifX.Driver_Deinit;
         cifX_Driver_Init_Done := False;
      end if;

      A4A.Log.Logger.Put (Who  => My_Ident,
                          What => "finished !");
      A4A.Log.Quit;

   end Close;

begin

   A4A.Log.Logger.Put (Who  => My_Ident,
                       What => "Test_Messaging...");

   A4A.Log.Logger.Put (Who  => My_Ident,
                       What => "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

      A4A.Log.Logger.Put (Who  => My_Ident,
                          What => "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

      A4A.Log.Logger.Put (Who  => My_Ident,
                          What => "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

      My_Channel_Messaging.Initialise (Channel_Handle => Channel_Handle);

      rcX_Firmware_Identify_FB.Initialise
        (Channel_Access => My_Channel_Messaging'Unrestricted_Access);

      loop

         Do_Command := not Command_Done;

         rcX_Firmware_Identify_FB.Cyclic
           (Do_Command => Do_Command,
            Done       => Command_Done,
            Error      => Command_Error);

         exit when not Do_Command;

         delay 0.1;

      end loop;

      if not Command_Error then

         Fw_Identification := rcX_Firmware_Identify_FB.Get_Data;

         cifX_Show_Firmware_Identification;

      else

         DWord_Text_IO.Put
           (To   => Error_String,
            Item => rcX_Firmware_Identify_FB.Get_Last_Error,
            Base => 16);

         A4A.Log.Logger.Put (Who  => My_Ident,
                             What => "Got an error : " & Error_String);

      end if;

   end if;

   Close;

exception

   when Error: others =>
      A4A.Log.Logger.Put (Who  => My_Ident,
                          What => Exception_Information(Error));

      Close;

end Test_rcX_Firmware_Identify;

La trace suivante montre notre code à l’œuvre, et ça fonctionne !

C:\GNAT\Projects\A4A\hilscherx\exe\test_rcx_firmware_identify
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Test_Messaging...
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Initializing cifX Driver
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Opening Driver
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Opening Channel
2014-06-13 07:31:36.12 => A4A.Protocols.HilscherX.Channel_Messaging.Receive_Msg_Task_Type : Got a message :
Dest    :               16#20#
Src     :                16#0#
Dest_Id :                16#1#
Src_Id  :           16#28FD48#
Cmd     :             16#1EB7#
2014-06-13 07:31:36.30 => Test_rcX_Firmware_Identify :
***********************************************
          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
***********************************************

2014-06-13 07:31:37.12 => A4A.Protocols.HilscherX.Channel_Messaging.Receive_Msg_Task_Type : No packet pending.
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Closing Channel
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Closing Driver
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Deinitializing cifX Driver
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : finished !
Logging_Task terminated...

[2014-06-13 09:31:38] process terminated successfully, elapsed time: 03.73s

Quelques blocs fonctions de ce type sont aujourd’hui disponibles dans « Ada for Automation ».

L’API Hilscher est riche, les protocoles supportés nombreux, et il faudra un peu de temps et beaucoup de contributions 😉 pour disposer de toute la fonctionnalité au niveau utilisateur.

N’hésitez pas à nous solliciter si vous souhaitez mettre en œuvre une solution « Ada for Automation » et qu’il vous manque des blocs. Ça doit pouvoir s’arranger…

Merci d’avance pour vos retours constructifs.

Cordialement,
Stéphane