Pseudo Visual Compiler using Interface to Ada as the OFP - Part 5 Continued

Pseudo Visual Compiler using Interface to Ada as the OFP - Part 5 Continued

The following is the second portion of the Pseudo Visual Compiler using Interface to Ada as the OFP - Part 5 post.  Please read it first.

New Packages - Framework (continued)

The ReceiveInterface component receives, via its queue, messages received from remote applications.  It then converts them back to Topic formatted messages and performs various validations.  Currently these are only that the topic is a valid combination, that the message has the correct length, and Heartbeat messages are valid.  When CRCs are implemented they will be validated as received in the particular Receive package.  Eventually various validations will be combined and the pipe will be closed if too many invalid messages are received.  (Such as messages for which there is no consumer.)

For messages other than Heartbeats and the need to request remote applications to forward any messages that they produce that the local app has components that want to consume, Delivery is invoked to cause it to be forwarded to the component or components that registered to consume it.

Other than Heartbeats, the special REGISTER REQUEST and RESPONSE messages are treated in ReceiveInterface.  The REGISTER REQUEST message is created when sufficient Heartbeats have been received.  This message is created via Library SendRegisterRequest to include, as data, the non-framework topics that components have registered to consume.  This is even if there is already a local producer of the topic since a remote app might not have a local consumer.  When the REGISTER REQUEST message is received by the ReceiveInterface of the remote application, it is forwarded to Library to add the topics to those for which there are consumers.

Note: For other REQUEST topics only one consumer is allowed since it is thought that only one component should be fulfilling the request and the response is to be returned to the particular requestor.  But this can't be enforced over multiple applications.  So if two applications consume the same REQUEST topic there can be two responses.

Since ReceiveInterface receives byte messages rather than in the normal Topic format, it uses a different queue – the DisburseBytes queue.  Also, unlike other components, its Write interface is visible to other packages so that Delivery isn't necessary.  This is because it is a framework component and only other framework components should be writing to its queue – namely Receive.  User components cannot register to produce framework topics and would have no need to deliver byte messages to ReceiveInterface which could only deliver them to other user components for which the use of Delivery is better suited.

ReceiveInterface.ads

with Itf;

package ReceiveInterface is

  -- Install the ReceiveInterface framework package to treat Receive messages

  function Install

  return Itf.ParticipantKeyType;

  -- Write a message to the DisburseQueue from multiple Receive threads

  function DisburseWrite

  ( Message : in Itf.BytesType

  ) return Boolean;

end ReceiveInterface;

ReceiveInterface.adb

with Component;

with Delivery;

with DisburseBytes;

with Format;

with Library;

with Remote;

with System;

with Text_IO;

with Topic;

with Unchecked_Conversion;

package body ReceiveInterface is

  package Int_IO is new Text_IO.Integer_IO( Integer );

  QueueName : Itf.V_Short_String_Type

            := ( Count => 19,

                 Data  => "ReceiveIntfaceQueue " );

  Key : Itf.ParticipantKeyType := Component.NullKey;

  -- Component's key returned from Register

  -- List of messages

  type ReceivedMessageArrayType

  is array (1..10) of Itf.MessageType;

  type ReceivedMessageListTableType

  is record

    Count      : Integer; -- number of entries

    NewlyAdded : Integer; -- number not yet Popped

    List       : ReceivedMessageArrayType;

  end record;

  -- Table of received messages

  MsgTable : ReceivedMessageListTableType;

  RequestTopic : Topic.TopicIdType;

  package DisburseQueue

  -- Instantiate disburse queue for the component

  is new DisburseBytes( QueueName => QueueName'Address,

                        Periodic  => False,

                        Universal => System.Null_Address,

                        Forward   => System.Null_Address );

  ReceiveInterfaceName : Itf.V_Medium_String_Type

  := ( Count => 16,

       Data  => "ReceiveInterface                                  " );

  Result : Component.RegisterResult;

  function to_Callback is new Unchecked_Conversion

                              ( Source => System.Address,

                                Target => Topic.CallbackType );

  procedure Main -- Threads callback

  ( T : in Boolean := False );

  -- Install the ReceiveInterface framework package to treat Receive messages

  function Install

  return Itf.ParticipantKeyType is

    Status : Library.AddStatus;

    use type Component.ComponentStatus;

    use type Library.AddStatus;

  begin -- Install

    -- Note: ReceiveInterface is not Transmit but it needs a way to register

    --       its queue as well as have its higher priority assigned.

    Result :=

      Component.RegisterTransmit

      ( Name       => ReceiveInterfaceName,

        RemoteId   => 0, -- not sending to remote app

        Callback   => to_Callback(Main'Address),

        Queue      => DisburseQueue.Location,

        QueueWrite => DisburseWrite'Address );

    if Result.Status = Component.VALID then

      DisburseQueue.ProvideWaitEvent( Event => Result.Event );

      Key := Result.Key;

      RequestTopic.Topic := Topic.ANY;

      RequestTopic.Ext   := Topic.FRAMEWORK;

      Status := Library.RegisterTopic( RequestTopic, Result.Key,

                                       Delivery.CONSUMER,

                                       to_Callback(Main'Address) );

      if Status /= Library.SUCCESS then

        Text_IO.Put_Line( "ERROR: Register of Topic failed" );

      end if;

    end if;

    return Key;

  end Install;

  -- The methods to validate the received message and forward it are below.

  -- These methods execute in the ReceiveInterface thread via the Callback

  -- forever loop started by the event initiated by the signal to end the wait.

  procedure AnnounceError

  ( RecdMessage : in Itf.BytesType

  ) is

    Length    : Integer := RecdMessage.Count;

    I         : Integer := 0;

    ZeroCount : Integer := 0;

    ZeroStart : Integer := 0;

    use type Itf.Byte;

  begin -- AnnounceError

    for J in 1..Length loop

      if RecdMessage.Bytes(J) = 0 then

        ZeroCount := ZeroCount + 1;

      else

        ZeroCount := 0;

        ZeroStart := J;

      end if;

    end loop;

    while Length > 0 loop

      if I > ZeroStart + 28 then

        exit;

      end if;

      if Length >= Integer(Itf.HeaderSize) then

        Text_IO.Put("ERROR: ");

        Int_IO.Put(Integer(RecdMessage.Bytes(I)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+1)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+2)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+3)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+4)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+5)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+6)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+7)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+8)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+9)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+10)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+11)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+12)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+13)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+14)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+15)));

        Int_IO.Put(Integer(RecdMessage.Bytes(I+16)));

        Text_IO.Put_Line(" ");

        Length := Length - Integer(Itf.HeaderSize);

        I := I + Integer(Itf.HeaderSize);

      else

        Length := 0;

      end if;

    end loop;

  end AnnounceError;

  -- Copy message into table

  procedure CopyMessage

  ( M           : in Integer;

    RecdMessage : in Itf.BytesType

  ) is

    Index : Integer;

    Size  : Itf.Int16;

    ReferenceNumber : Itf.Int32;

    use type Itf.Int16;

  begin -- CopyMessage

    MsgTable.Count := MsgTable.Count + 1;

    Index := MsgTable.Count;

    Size := Itf.Int16(RecdMessage.Bytes(M+1));

    Size := Itf.Int16(256 * Integer(Size) + (Integer(RecdMessage.Bytes(M+2))));

    MsgTable.List(Index).Header.CRC := Size;

    MsgTable.List(Index).Header.Id.Topic := Topic.Id_Type'Val(RecdMessage.Bytes(M+3));

    MsgTable.List(Index).Header.Id.Ext :=

      Topic.Extender_Type'Val(RecdMessage.Bytes(M+4));

    MsgTable.List(Index).Header.From.AppId := Itf.Int8(RecdMessage.Bytes(M+5));

    MsgTable.List(Index).Header.From.ComId := Itf.Int8(RecdMessage.Bytes(M+6));

    MsgTable.List(Index).Header.From.SubId := Itf.Int8(RecdMessage.Bytes(M+7));

    MsgTable.List(Index).Header.To.AppId := Itf.Int8(RecdMessage.Bytes(M+8));

    MsgTable.List(Index).Header.To.ComId := Itf.Int8(RecdMessage.Bytes(M+9));

    MsgTable.List(Index).Header.To.SubId := Itf.Int8(RecdMessage.Bytes(M+10));

    ReferenceNumber := Integer(RecdMessage.Bytes(M+11));

    ReferenceNumber := 256 * ReferenceNumber + Integer(RecdMessage.Bytes(M+12));

    ReferenceNumber := 256 * ReferenceNumber + Integer(RecdMessage.Bytes(M+13));

    ReferenceNumber := 256 * ReferenceNumber + Integer(RecdMessage.Bytes(M+14));

    MsgTable.List(Index).Header.ReferenceNumber := ReferenceNumber;

    Size := Itf.Int16(RecdMessage.Bytes(M+15));

    Size := 256 * Size + Itf.Int16(RecdMessage.Bytes(M+16));

    MsgTable.List(Index).Header.Size := Itf.Int16(Size);

    MsgTable.List(Index).Data := (others => ' ');

    for I in 1..Integer(Size) loop

      declare

        Pos  : Integer := Integer(RecdMessage.Bytes(M+I+Integer(Itf.HeaderSize)));

        Item : Character;

        for Item use at Pos'Address;

      begin

        MsgTable.List(Index).Data(I) := Item;

      end;

    end loop;

  end CopyMessage;

  procedure ParseRecdMessages

  ( RecdMessage : in Itf.BytesType

  ) is

    M    : Integer := 0;

    Id   : Topic.TopicIdType; -- topic;

    Size : Integer;

    use type Itf.Byte;

  begin -- ParseRecdMessages

    while M <= RecdMessage.Count loop

      if (M + Integer(Itf.HeaderSize)) <= RecdMessage.Count then -- space for header

        Id.Topic := Topic.Id_Type'val(RecdMessage.Bytes(M + 3));

        Id.Ext := Topic.Extender_Type'val(RecdMessage.Bytes(M + 4));

        if Library.ValidPairing(Id) then

          -- assuming if Topic Id is valid that the remaining data is as well

          Size := Integer(RecdMessage.Bytes(M + 15)) * 256;  -- 8 bit shift

          Size := Size + Integer(RecdMessage.Bytes(M + 16)); -- data size

          if (M + Size + Integer(Itf.HeaderSize)) <= RecdMessage.Count then

            -- space for message

            CopyMessage(M, RecdMessage);

          end if;

          M := M + Size + Integer(Itf.HeaderSize);

        end if;

      else -- scan for another message

        for N in M..RecdMessage.Count loop

          Id.Topic := Topic.Id_Type'val(RecdMessage.Bytes(N));

          if (N+1) >= RecdMessage.Count then

            return; -- no space left

          end if;

          Id.Ext := Topic.Extender_Type'val(RecdMessage.Bytes(N + 1));

          if Library.ValidPairing(Id) then

            M := N;

            exit; -- inner loop

          end if;

        end loop;

      end if;

      exit; -- outer loop

    end loop;

  end ParseRecdMessages;

  -- Determine if 3 or more consecutive heartbeats have been received and

  -- the Register Request has been acknowledged or the needs to be sent.

  procedure TreatHeartbeatMessage

  ( RemoteAppId : in Itf.Int8

  ) is

    Acknowledged : Boolean;

    ConsecutiveValid : Integer

      := Remote.ConsecutiveValidHeartbeats(RemoteAppId);

  begin -- TreatHeartbeatMessage

    Int_IO.Put(ConsecutiveValid);

    Text_IO.Put_Line(" ");

    if ConsecutiveValid >= 3 then -- connection established

      Remote.SetConnected(RemoteAppId, True);

      Acknowledged := Remote.RegisterAcknowledged(RemoteAppId);

      if not Acknowledged and then

         (ConsecutiveValid mod 3) = 0

      then -- where only every 3rd time to allow acknowledged to be set

        Library.SendRegisterRequest(RemoteAppId);

      end if;

    end if;

  end TreatHeartbeatMessage;

  -- Validate any heartbeat message.

  -- Notes: A heartbeat message must identify that it is meant for this

  --        application and originated in the remote application for

  --        which this instantiation of the Receive thread is responsible.

  function HeartbeatMessage

  ( RecdMessage : in Itf.MessageType;

    RemoteAppId : in Itf.Int8

  ) return Boolean is

    HeartbeatMessage : Boolean := False;

    ConsecutiveValid : Integer

      := Remote.ConsecutiveValidHeartbeats(RemoteAppId);

  begin -- HeartbeatMessage

    HeartbeatMessage := Format.DecodeHeartbeatMessage(RecdMessage, RemoteAppId);

    if HeartbeatMessage then

      ConsecutiveValid := ConsecutiveValid + 1;

    else

      ConsecutiveValid := 0;

    end if;

    Remote.ConsecutiveValidHeartbeats( RemoteAppId, ConsecutiveValid );

    -- Return whether a Heartbeat message; whether or not valid.

    return HeartbeatMessage;

  end HeartbeatMessage;

  -- Non-Heartbeat Messages have to be messages formatted as framework topic

  -- messages.  Otherwise, they will be discarded.  These topic messages will

  -- be forwarded to the component(s) that has/have registered to consume them.

  procedure ForwardMessage

  ( Message : in Itf.MessageType

  ) is

    use type Topic.Extender_Type;

    use type Topic.Id_Type;

  begin -- ForwardMessage

    -- Check if a framework Register message.

    if Message.Header.Id.Topic = Topic.REGISTER then -- Check if acknowledge

      if Message.Header.Id.Ext = Topic.RESPONSE then

        Remote.SetRegisterAcknowledged(Message.Header.From.AppId, True);

      else -- register Request message

        Library.RegisterRemoteTopics(Message.Header.From.AppId, Message);

      end if;

    else -- Forward other messages

      Delivery.Publish(Message);

    end if;

  end ForwardMessage;

  procedure Main -- callback

  ( T : in Boolean := False

  ) is

    RecdMessage : Itf.BytesType;

  begin -- Main

    Text_IO.Put_Line("in ReceiveInterface callback");

    loop -- forever

      DisburseQueue.EventWait; -- wait for event

      loop -- until queue is empty

        if DisburseQueue.Unread then

          RecdMessage := DisburseQueue.Read;

          if RecdMessage.Count > 0 then

            -- message to be converted and treated

            if RecdMessage.Count >= Integer(Itf.HeaderSize) then -- message can have a             

              declare                                            –-   header

                TopicId : Topic.TopicIdType;

                Valid   : Boolean;

              begin

                TopicId.Topic := Topic.Id_Type'val(RecdMessage.Bytes(3));

                TopicId.Ext := Topic.Extender_Type'val(RecdMessage.Bytes(4));

                Valid := Library.ValidPairing(TopicId);

                if not Valid then

                  AnnounceError(RecdMessage);

                else -- Convert received message(s) to topic messages.

                  MsgTable.Count := 0;

                  ParseRecdMessages(recdMessage);

                  if MsgTable.Count > 0 then

                    for M in 1..MsgTable.Count loop

                      declare

                        Msg : Itf.MessageType;

                        for Msg use at MsgTable.List(M)'address;

                        use type Topic.Extender_Type;

                        use type Topic.Id_Type;

                      begin

                        if ((Msg.Header.Id.Topic = Topic.HEARTBEAT) and then

                            (Msg.Header.Id.Ext = Topic.FRAMEWORK))

                        then

                          if HeartbeatMessage(Msg,Msg.Header.From.AppId) then

                            TreatHeartbeatMessage(Msg.Header.From.AppId);

                          else

                            Remote.SetConnected(Msg.Header.From.AppId,False);

                          end if;

                        else

                          ForwardMessage(Msg);

                        end if;

                      end;

                    end loop;

                  end if; -- MsgTable.Count > 0

                end if; -- valid pairing

              end; -- declare block

            end if; -- Length large enough

          end if; -- RecdMessage.Length > 0

        else -- DisburseQueue has no messages to read

          exit; -- the inner loop

        end if; -- DisburseQueue.Unread

      end loop; -- until queue empty

    end loop; -- forever

  end Main;

  -- Write a message to the DisburseQueue from multiple Receive threads

  -- Note: Doing this write will queue the message in the thread of the

  --       particular Receive thread.  The forever loop will then have its

  --       wait signaled to continue and the queue can be read in the thread

  --       of this component to treat the message and deliver it.

  function DisburseWrite

  ( Message : in Itf.BytesType

  ) return Boolean is

  begin -- DisburseWrite

    return DisburseQueue.Write(Message);

  end DisburseWrite;

end ReceiveInterface;

Modified Packages from previous posts

The Itf package spec has some additions while the package body is unchanged.

Itf.ads

with Topic;

package Itf is

  type Int8  is new Integer range  -2**7+1..2**7-1;

  for Int8'Size use 8; -- bits

  type Int16 is new Integer range -2**15+1..2**15-1;

  for Int16'Size use 16; -- bits

  subtype Int32 is Integer range -2**31+1..2**31-1;

  type Interface_Integer

  is range -(2 ** 31) .. (2 ** 31) - 1;

  type Nat8  is new Natural range 0..2**8-1;

  for Nat8'Size use 8;

  type Nat32 is new Natural;

  type Byte

  -- 8-bit byte

  is mod 2**8;

  for Byte'Size use 8;

  type Word

  -- 16-bit word

  is mod 2**16;

  for Word'Size use 16;

  type Longword

  -- 32-bit longword

  is range -(2**31) .. 2**31 - 1;

  for Longword'Size use 32;

  type ByteArray

  -- Unconstrained array of bytes

  is array (Integer range <>) of Byte;

  type ApplicationIdType is

  record

    Name : String(1..10);

    Id   : Int8;

  end record;

  type ApplicationNameType

  --| Character string identifying the hosted function application

  is new String(1..10);

  ApplicationId : Itf.ApplicationIdType; -- the local AppId

  -- Possible methods of inter-application communications

  type CommMethodType

  is ( NONE,    -- Topic added to the library

       MS_PIPE, -- Topic already added for the component

       TCP_IP   -- Topic not added

     );

  Configuration_App_Path_Max

  -- Maximum length of application path

  : constant Integer := 150;

  type V_Short_String_Type

  is record

    Count : Integer;

    Data  : String(1..20);

  end record;

  type V_Medium_String_Type

  is record

    Count : Integer;

    Data  : String(1..50);

  end record;

  type V_Long_String_Type

  is record

    Count : Integer;

    Data  : String(1..Configuration_App_Path_Max);

  end record;

  type Message_Size_Type

  -- Number of total message bytes in any protocol message

  is new Natural range 0..4096;

  subtype Message_Data_Count_Type

  -- Number of message data bytes in topic protocol message

  is Message_Size_Type

  range Message_Size_Type'first..4096;

  type Message_Buffer_Type

  -- Message buffer for remote messages

  is array( 1..Message_Data_Count_Type'last ) of Byte;

  Message_Size

  --| Maximum message size; Header and data

  : constant := 4096; -- bytes

  Message_Alignment

  -- Byte boundary at which to align message header and topic buffer

  : constant := 4;

  type GenericMessageType is private;

  -- Identifier of component

  type ParticipantKeyType

  is record

    AppId : Int8; -- application identifier

    ComId : Int8; -- component identifier

    SubId : Int8; -- subcomponent identifier

  end record;

  type HeaderType

  is record

    CRC  : Int16;              -- message CRC

    Id   : Topic.TopicIdType;  -- topic of the message

    From : ParticipantKeyType; -- publishing component

    To   : ParticipantKeyType; -- consumer component

    ReferenceNumber : Int32;   -- reference number of message

    Size : Int16;              -- size of data portion of message

  end record;

  for HeaderType

  use record

    CRC    at  0 range 0..15;

    Id     at  2 range 0..15;

    From   at  4 range 0..23;

    To     at  7 range 0..23;

    ReferenceNumber at 10 range 0..31;

    Size   at 14 range 0..15;

  end record;

  HeaderSize

  : constant Int16 := 16;

  -- A message consists of the header data and the actual data of the message

  type MessageType

  is record

    Header : HeaderType;

    Data   : String(1..4080);

  end record;

  MessageSize : constant Integer := 250;

  -- A message as received by NamedPipe to be queued to ReceiveInterface

  type BytesType

  is record

    Count : Integer; -- number of bytes in message

    Bytes : Itf.ByteArray(1..MessageSize);

  end record;

  -- Callback types of instantiation of NamedPipe

  type ReceiveOpenCallbackType

  -- Callback to open a receive pipe

  is access function

  ( RemoteAppId : in Int8

    -- Receive pipe to be opened

  ) return Boolean;

  type ReceiveCallbackType

  -- Callback to execute receive message to be transmitted

  is access procedure

  ( Pair    : in Int8;

    -- Pair index of receive pipe

    Message : out BytesType

    -- Received Message to be returned

  );

  type TransmitCallbackType

  -- Callback to execute receive message to be transmitted

  is access procedure

  ( Message : in BytesType

    -- Message to be transmitted

  );

  -- Declarations for Forward Table to be used by an instantiation of Disburse

  type ForwardType

  -- Callback to forward message to component message callback

  is access procedure

            ( Message : in MessageType );

  type DisburseDataType

  is record

    TopicId : Topic.TopicIdType;

    Forward : ForwardType;

  end record;

  type DisburseDataArrayType

  is array(1..10) of DisburseDataType;

  -- Table of topics to disburse to their callback

  type DisburseTableType

  is record

    Count : Integer;

    List  : DisburseDataArrayType;

  end record;

  NullMessage : MessageType;

  procedure Initialize;

private

  type GenericMessageType

  -- Message of any protocol

  is array( 1..Message_Size ) of Byte;

  for GenericMessageType'alignment use Message_Alignment;

end Itf;

Component has changes to have special Register methods for Receive and Transmit components and functions to forward particular Delivery messages to Write to the queue of the component to take delivery of the message.  The component table and the types that it needs are visible which should most likely be hidden.  The table is used in Threads but the necessary data could be returned via a function.

Component.ads

with Configuration;

with ExecItf;

with Itf;

with Topic;

with Threads;

with System;

package Component is

  MaxUserComponents

  -- Maximum allowed number of user (non-framework) components

  : constant Integer := 8;

  MaxComponents

  : constant Integer := 8 + (2 * (Configuration.MaxApplications - 1));

  NullKey : Itf.ParticipantKeyType;

  type ComponentStatus

  is ( NONE,

       VALID,

       DUPLICATE,

       INVALID,

       INCONSISTENT,

       INCOMPLETE

     );

  type ComponentKind

  is ( USER,

       FRAMEWORK,

       RECEIVE,   -- special framework component

       TRANSMIT   -- special framework component

     );

  type ComponentSpecial

  is ( NORMAL,

       RECEIVE,

       RECEIVEINTERFACE,

       TRANSMIT

     );

  type RegisterResult

  is record

    Status : ComponentStatus;

    Key    : Itf.ParticipantKeyType;

    Event  : ExecItf.HANDLE;

  end record;

  type DisburseWriteCallback

  -- Callback to execute the Write function of a participant component's

  -- Disburse queue

  is access function

  ( Message : in Itf.MessageType

    -- Message to be written to the queue

  ) return Boolean; -- indicates if Write was successful

  -- Component data from registration as well as run-time status

  type ComponentDataType

  is record

    Kind        : ComponentKind;

    -- Whether user component or a framework component

    Name        : Itf.V_Medium_String_Type;

    -- Component name

    Key         : Itf.ParticipantKeyType;

    -- Component key (application and component identifiers)

    RemoteAppId : Itf.Int8;

    -- Remote application for transmit

    Period      : Integer;

    -- Periodic interval in milliseconds; 0 if only message consumer

    Priority    : Threads.ComponentThreadPriority;

    -- Requested priority for component

    fMain       : Topic.CallbackType;

    -- Main entry point of the component

    WaitEvent   : ExecItf.HANDLE;

    -- Wait Event associated component

    Queue       : System.Address;

    -- Message queue of the component

    QueueWrite  : DisburseWriteCallback;

    -- Callback to Write to the component's queue

    Special     : ComponentSpecial;

    -- Special processing

  end record;

  type ComponentDataArrayType is array (1..MaxComponents) of ComponentDataType;

  -- List of components

  type ComponentTableType

  is record

    AllowComponentRegistration : Boolean;

    -- True indicates that components are allowed to register themselves

    Count                      : Integer;

    -- Number of registered components of the application

    List                       : ComponentDataArrayType;

    -- Registration supplied data concerning the component as well as

    -- run-time status data

  end record;

  -- Component table containing registration data as well as run-time status data

  -- Note: I would like to keep this table hidden from components but I don't

  --       know how to structure C# so that classes of a certain kind (that is,

  --       App, Component, Threads, etc) aren't directly visible to components

  --       such as ComPublish.

  -- Note: There must be one creation of a new table.  Only one instance.

  ComponentTable : ComponentTableType;

  -- true if Component class has been initialized

  ComponentInitialized : Boolean := False;

  -- Determine if two components are the same

  function CompareParticipants

  ( Left  : in Itf.ParticipantKeyType;

    Right : in Itf.ParticipantKeyType

  ) return Boolean;

  -- Forward Message to Callback of Component

  function DisburseWrite

  ( ComponentKey : in Itf.ParticipantKeyType;

    -- Component for message delivery

    Message      : in Itf.MessageType

    -- Message to be delivered

  ) return Boolean; -- true indicates successful write to queue

  -- Forward Message to instantiation of Transmit package to send to remote app

  function TransmitWrite

  ( RemoteAppId : in Itf.Int8;

    -- Transmit component to send Message

    Message     : in Itf.MessageType

    -- Message to be delivered

  ) return Boolean; -- true indicates successful write to queue

                                     

  procedure Initialize;

  -- Register User Component

  function Register

  ( Name       : in Itf.V_Medium_String_Type; -- name of component

    RemoteId   : in Itf.Int8 := 0;      -- remote id for transmit

    Period     : in Integer; -- # of millisec at which Main() function to cycle

    Priority   : in Threads.ComponentThreadPriority; -- Requested priority of thread

    Callback   : in Topic.CallbackType; -- Callback function of component

    Queue      : in System.Address;     -- message queue of component

    QueueWrite : in System.Address      -- queue Write function address

  ) return RegisterResult;

  -- Register Receive Component

  function RegisterReceive

  ( Name     : in Itf.V_Medium_String_Type; -- name of component

    Callback : in Topic.CallbackType        -- Callback function of component

  ) return RegisterResult;

  -- Register Transmit Component

  function RegisterTransmit

  ( Name       : in Itf.V_Medium_String_Type; -- name of component

    RemoteId   : in Itf.Int8;                 -- remote app to transmit to

    Callback   : in Topic.CallbackType;       -- Callback function of component

    Queue      : in System.Address;           -- message queue of component

    QueueWrite : in System.Address            -- queue Write function address

  ) return RegisterResult;

end Component;

Component.adb

with CStrings;

with System;

with Text_IO;

with Unchecked_Conversion;

package body Component is

  package Int_IO is new Text_IO.Integer_IO( Integer );--debug

  Kind : ComponentKind := USER; -- can be overridden by Register of Receive, etc

  -- Find the index into the registered Application table of the currently

  -- running application and return it.

  function ApplicationIndex

  return Itf.Int8 is

    Index : Itf.Int8; -- Index of hosted function application in Application table

    use type Itf.Int8;

  begin -- ApplicationIndex

    -- Find index to be used for hosted function application processor

    Index := Itf.ApplicationId.Id;

    if Index = 0 then

      Text_IO.Put_Line("ERROR: Application Index doesn't exist");

    end if;

    return index;

  end ApplicationIndex;

  function CompareParticipants

  ( Left  : in Itf.ParticipantKeyType;

    Right : in Itf.ParticipantKeyType

  ) return Boolean is

    use type Itf.Int8;

  begin -- CompareParticipants

    -- Determine if two components are the same

    if ((Left.AppId = Right.AppId) and then

        (Left.ComId = Right.ComId) and then

        (Left.SubId = Right.SubId))

    then

      return True;

    else

      return False;

    end if;

  end CompareParticipants;

  function DisburseWrite

  ( ComponentKey : in Itf.ParticipantKeyType;

    Message      : in Itf.MessageType

  ) return Boolean is

  begin -- DisburseWrite

    for I in 1..ComponentTable.Count loop

      if CompareParticipants(ComponentTable.List(I).Key, ComponentKey) and then

         ComponentTable.List(I).QueueWrite /= null

      then

        return ComponentTable.List(I).QueueWrite(Message);

      end if;

    end loop;

    Text_IO.Put("Failed to find Component for ");

    Text_IO.Put_Line(Message.Data(1..2));

    return False; -- no component to which to write the message

  end DisburseWrite;

  -- Forward Message to instantiation of Transmit package to send to remote app

  function TransmitWrite

  ( RemoteAppId : in Itf.Int8;

    Message     : in Itf.MessageType

  ) return Boolean is

    Success : Boolean;

    use type Itf.Int8;

  begin -- TransmitWrite

    if RemoteAppId /= 0 then

      for I in 1..ComponentTable.Count loop

        if ComponentTable.List(I).RemoteAppId = RemoteAppId then

          return ComponentTable.List(I).QueueWrite(Message);

        end if;

      end loop;

      return False; -- no Transmit component to send message to remote app

    else -- forward to all Transmit components

      for I in 1..ComponentTable.Count loop

        if ComponentTable.List(I).Kind = TRANSMIT then

          Success := ComponentTable.List(I).QueueWrite(Message);

        end if;

      end loop;

      return True;

    end if;

  end TransmitWrite;

  procedure Initialize is

  begin -- Initialize

    NullKey.AppId := 0;

    NullKey.ComId := 0;

    NullKey.SubId := 0;

    ComponentTable.Count := 0;

    ComponentTable.AllowComponentRegistration := False;

  end Initialize;

  -- Look up the Name in the registered component and return the index of where

  -- the data has been stored.  Return zero if the Name is not in the list.

   function Lookup

   ( Name : in Itf.V_Medium_String_Type

   ) return Integer is

     App : Itf.Int8; -- Application id

     Idx : Integer;  -- Index of component in registry

     CompareName : String(1..Name.Count+1);

   begin -- Lookup

     App := ApplicationIndex;

     CompareName(1..Name.Count) := Name.Data(1..Name.Count);

     CompareName(Name.Count+1) := ASCII.NUL;

     Idx := 0;

     for I in 1..ComponentTable.Count loop

       declare

         TableName : String(1..ComponentTable.List(I).Name.Count+1);

       begin

         if Name.Count = ComponentTable.List(I).Name.Count then

           TableName(1..Name.Count) :=

             ComponentTable.List(I).Name.Data(1..Name.Count);

           TableName(Name.Count+1) := ASCII.NUL;

           if CStrings.Compare( Left       => CompareName'Address,

                                Right      => TableName'Address,

                                IgnoreCase => True ) = 0

           then

             Idx := I;

             exit; -- loop

           end if;

         end if;

       end;

     end loop;

    -- Return the index.

    return Idx;

  end Lookup;

  -- Increment the identifier of the component key and then return it with

  -- the application identifier as the next available component key.

  function NextComponentKey

  return Itf.ParticipantKeyType is

    App       : Itf.Int8; -- Index of current application

    ReturnApp : Itf.ParticipantKeyType;

  begin -- NextComponentKey

    App := ApplicationIndex;

    if ComponentTable.Count < MaxComponents then

      ComponentTable.Count := ComponentTable.Count + 1;

      ReturnApp.AppId := App;

      ReturnApp.ComId := Itf.Int8(ComponentTable.Count);

      ReturnApp.SubId := 0;

      return ReturnApp;

    else

      Text_IO.Put_Line("ERROR: More components than can be accommodated");

      return NullKey;

    end if;

  end NextComponentKey;

  function Register

  ( Name       : in Itf.V_Medium_String_Type; -- name of component

    RemoteId   : in Itf.Int8 := 0;  -- remote id for transmit

    Period     : in Integer; -- # of millisec at which Main function to cycle

    Priority   : in Threads.ComponentThreadPriority; -- Requested priority of thread

    Callback   : in Topic.CallbackType; -- Callback function of component

    Queue      : in System.Address; -- Disburse.QueuePtrType

    QueueWrite : in System.Address  -- message queue Write function of component

  ) return RegisterResult is

    App      : Itf.Int8; -- Index of current application

    CIndex   : Integer;  -- Index of component; 0 if not found

    Location : Integer;  -- Location of component in the registration table

    NewKey   : Itf.ParticipantKeyType; -- component key of new component

    Result   : RegisterResult;

    function to_Write_Ptr is new Unchecked_Conversion

                                 ( Source => System.Address,

                                   Target => DisburseWriteCallback );

    use type Topic.CallbackType;

  begin -- Register

    Result.Status := NONE; -- unresolved

    Result.Key    := NullKey;

    Result.Event  := System.Null_Address;

    NewKey := NullKey;

    -- Find index to be used for application

    App := ApplicationIndex;

    -- Look up the component in the Component Table

    CIndex := Lookup(Name);

    -- Return if component has already been registered

    if CIndex > 0 then -- duplicate registration

      Result.Status := DUPLICATE;

      return Result;

    end if;

    -- Return if component is periodic but without a Main entry point.

    if Period > 0 then

      if Callback = null then

        Result.Status := INVALID;

        return Result;

      end if;

    end if;

    -- Add new component to component registration table.

    --

    --   First obtain the new table location and set the initial values.

    NewKey := NextComponentKey;

    Location := ComponentTable.Count;

    ComponentTable.List(Location).Kind := Kind;

    ComponentTable.List(Location).Name := Name;

    Kind := USER; -- clear Kind for next Register

    declare

      EventName : String(1..Name.Count+1);

      package Int_IO is new Text_IO.Integer_IO( Integer );

      function to_Int is new Unchecked_Conversion( Source => ExecItf.HANDLE,

                                                   Target => Integer );

    begin

      EventName(1..Name.Count) := Name.Data(1..Name.Count);

      EventName(Name.Count+1) := ASCII.NUL; -- terminating NUL

      Result.Event := ExecItf.CreateEvent( ManualReset  => True,

                                           InitialState => False,

                                           Name         => EventName'Address );

      Text_IO.Put("EventName ");

      Text_IO.Put(EventName);

      Text_IO.Put(" ");

      Int_IO.Put(to_Int(Result.Event));

      Text_IO.Put_Line(" ");

    end;

    ComponentTable.List(Location).Key := NewKey;

    ComponentTable.List(Location).RemoteAppId := RemoteId;

    ComponentTable.List(Location).Period := Period;

    ComponentTable.List(Location).Priority := Priority;

    ComponentTable.List(Location).fMain := Callback;

    ComponentTable.List(Location).WaitEvent := Result.Event;

    ComponentTable.List(Location).Queue := Queue;

    ComponentTable.List(Location).QueueWrite := to_Write_Ptr(QueueWrite);

    -- Return status and the assigned component key.

    Result.Status := VALID;

    Result.Key := NewKey;

    return Result;

  end Register;

  -- Register Receive Component

  function RegisterReceive

  ( Name     : in Itf.V_Medium_String_Type; -- name of component

    Callback : in Topic.CallbackType        -- Callback function of component

  ) return RegisterResult is

  begin -- RegisterReceive

    Kind := RECEIVE;

    return Register( Name       => Name,

                     Period     => 0,

                     Priority   => Threads.HIGH,

                     Callback   => Callback,

                     Queue      => System.Null_Address,

                     QueueWrite => System.Null_Address );

  end RegisterReceive;

  -- Register Transmit Component

  function RegisterTransmit

  ( Name       : in Itf.V_Medium_String_Type; -- name of component

    RemoteId   : in Itf.Int8;                 -- remote app to transmit to

    Callback   : in Topic.CallbackType;       -- Callback function of component

    Queue      : in System.Address;           -- message queue of component

    QueueWrite : in System.Address            -- queue Write function address

  ) return RegisterResult is

    use type Itf.Int8;

  begin -- RegisterTransmit

    if RemoteId = 0 then

      Kind := FRAMEWORK;

    else

      Kind := TRANSMIT;

    end if;

    return Register( Name       => Name,

                     RemoteId   => RemoteId,

                     Period     => 0,

                     Priority   => Threads.HIGH,

                     Callback   => Callback,

                     Queue      => Queue,

                     QueueWrite => QueueWrite );

  end RegisterTransmit;

end Component;

Delivery has some minor changes from the last time published.

Delivery.ads

with Component;

with Itf;

with Topic;

package Delivery is

  type DistributionType

  is ( CONSUMER,

       PRODUCER

     );

  procedure Initialize;

  -- Initialize Delivery package

  procedure Publish

  ( Message : in Itf.MessageType );

  -- Re-Publish message received from Remote via ReceiveInterface

  procedure Publish

  ( RemoteAppId : in Itf.Int8;

    Message     : in out Itf.MessageType );

  -- Publish message to Remote such as Register Request

  procedure Publish

  ( TopicId      : in Topic.TopicIdType;

    ComponentKey : in Itf.ParticipantKeyType;

    Message      : in String );

  -- Publish local message except for Response message

  procedure Publish

  ( TopicId      : in Topic.TopicIdType;

    ComponentKey : in Itf.ParticipantKeyType;

    From         : in Itf.ParticipantKeyType;

    Message      : in String );

  -- Publish local Response message to specify the source of Request message

end Delivery;

Delivery.adb

with Disburse;

with Library;

with Remote;

with System;

with Text_IO;

with Unchecked_Conversion;

package body Delivery is

  package Int_IO is new Text_IO.Integer_IO( Integer ); -- for debug

  ReferenceNumber : Itf.Int32; -- ever increasing message reference number

  type QueueCallbackType

  -- Callback to execute a Queue Write

  is access function

  ( Message : in Itf.MessageType

  ) return Boolean;

  function to_Ptr is new Unchecked_Conversion

                         ( Source => System.Address,

                           Target => QueueCallbackType );

  procedure Initialize is

  begin -- Initialize

    ReferenceNumber := 0; -- ever increment for each message

  end Initialize;

  procedure PublishResponseToRequestor

  ( TopicId   : in Topic.TopicIdType;

    Consumers : in out Library.TopicTableType;

    Msg       : in Itf.MessageType

  ) is

    Found : Boolean := False;

    use type System.Address;

  begin -- PublishResponseToRequestor

    for I in 1..Consumers.Count loop

      if Component.CompareParticipants( Msg.Header.To,

                                        Consumers.List(I).ComponentKey )

      then -- return response to the requestor

        Consumers.List(I).ReferenceNumber := 0;

        Found := Component.DisburseWrite( Consumers.List(I).ComponentKey,

                                          Msg );

      end if;

    end loop;

    if not Found then

      Text_IO.Put_Line("ERROR: Delivery couldn't find requestor for response");

    end if;

  end PublishResponseToRequestor;

  -- Remote messages are to be ignored if the From and To components are

  -- the same since this would transmit the message back to the remote app.

  -- Remote messages are only to be forwarded to the To component and not

  -- to all the components of the consumers list since separate messages

  -- are sent by the remote component for each local consumer.

  function Ignore

  ( Message      : in Itf.MessageType;

    ComponentKey : in Itf.ParticipantKeyType

  ) return Boolean is

    Equal : Boolean;

    use type Itf.Int8;

  begin -- Ignore

    Equal := Component.CompareParticipants

             ( Message.Header.From, Message.Header.To);

    if Equal and then Message.Header.To.AppId /= Itf.ApplicationId.Id then

      -- same from and to component and remote message

      return True;

    end if;

    if Message.Header.From.AppId /= Itf.ApplicationId.Id then

      -- remote message; check if consumer component is 'to' participant

      if not Component.CompareParticipants

             ( Message.Header.To, ComponentKey )

      then

        return True;

      end if;

    end if;

    return False;

  end Ignore;

  -- Remote messages are to be ignored if the From and To components are

  -- the same since this would transmit the message back to the remote app.

  -- Remote messages are only to be forwarded to the To component and not

  -- to all the components of the consumers list since separate messages

  -- are sent by the remote component for each local consumer.

  function Ignore

  ( To           : in Itf.ParticipantKeyType;

    From         : in Itf.ParticipantKeyType;

    ComponentKey : in Itf.ParticipantKeyType

  ) return Boolean is

    Equal : Boolean;

    use type Itf.Int8;

  begin -- Ignore

    Equal := Component.CompareParticipants(From, To);

    if Equal and then To.AppId /= Itf.ApplicationId.Id then

      -- same from and to component and remote message

      return True;

    end if;

    if From.AppId /= Itf.ApplicationId.Id and then -- from is remote

       ComponentKey.AppId = Itf.ApplicationId.Id   -- component is local

    then -- remote message; check if consumer component is 'to' participant

      if not Component.CompareParticipants(To, ComponentKey) then

        return True;

      end if;

    end if;

    return False;

  end Ignore;

  procedure Publish

  ( Message : in Itf.MessageType

  ) is

    Consumers : Library.TopicTableType;

    Found     : Boolean;

    use type Itf.Int8;

    use type System.Address;

    use type Topic.Extender_Type;

    use type Topic.Id_Type;

  begin -- Publish

    -- Get the set of consumers of the topic

    Consumers := Library.TopicConsumers(Message.Header.Id);

    if Message.Header.Id.Ext = Topic.REQUEST then

      -- forward the request topic to its consumer

      for I in 1..Consumers.Count loop

        if Message.Header.Id.Topic = Consumers.List(I).Id.Topic then

          -- the only possible consumer of the request topic

          Consumers.List(I).Requestor := Message.Header.From;

          Consumers.List(I).ReferenceNumber := Message.Header.ReferenceNumber;

          Found := Component.DisburseWrite( Consumers.List(I).ComponentKey,

                                            Message );

          if not Found then

            Text_IO.Put

            ("ERROR: remote Request Delivery couldn't find queue for consumer ");

            Int_IO.Put(Integer(Message.Header.From.AppId));

            Text_IO.Put(" ");

            Int_IO.Put(Integer(Message.Header.From.ComId));

            Text_IO.Put(" ");

            Int_IO.Put(Integer(Message.Header.To.AppId));

            Text_IO.Put(" ");

            Int_IO.Put(Integer(Message.Header.To.ComId));

            Text_IO.Put(" Topic ");

            Int_IO.Put(Integer(Topic.Id_Type'pos(Message.Header.Id.Topic)));

            Text_IO.Put(" ");

            Int_IO.Put(Integer(Topic.Extender_Type'pos(Message.Header.Id.Ext)));

            Text_IO.Put_Line(" ");

          else

            return; -- can only be one consumer

          end if;

        end if;

      end loop;

    elsif Message.Header.Id.Ext = Topic.RESPONSE then

      -- forward the response topic to the request publisher

      for I in 1..Consumers.Count loop

        if Message.Header.Id.Topic = Consumers.List(I).Id.Topic and then

           Component.CompareParticipants(Consumers.List(I).ComponentKey,

                                         Message.Header.To)

        then -- found the publisher of the Request

          Found := Component.DisburseWrite( Consumers.List(I).ComponentKey,

                                            Message );

          if not Found then

            Text_IO.Put_Line(

              "ERROR: Remote Response Delivery couldn't find queue for consumer");

          end if;

          Exit; -- loop

        end if;

      end loop;

    else -- Default topic - forward to possible multiple consumers

      for I in 1..Consumers.Count loop

        if Message.Header.Id.Topic = Topic.HEARTBEAT then

          null;

        end if;

        -- Avoid sending topic back to the remote app that transmitted it to

        -- this app or forwarding a remote message that is to be delivered to

        -- a different component.

        if Consumers.List(I).Id.Topic = Message.Header.Id.Topic and then

           Ignore(Message.Header.To, Message.Header.From,

                  Consumers.List(I).ComponentKey)

        then

          null;

        else -- Deliver message to local application by copying to its queue

          Consumers.List(I).Requestor := Message.Header.From;

          Consumers.List(I).ReferenceNumber := 0;

          if Consumers.List(I).ComponentKey.AppId = Itf.ApplicationId.Id then

            Found := Component.DisburseWrite( Consumers.List(I).ComponentKey,

                                              Message );

            if not Found then

              Text_IO.Put_Line("ERROR: Remote default Delivery couldn't find queue for consumer");

              Int_IO.Put(Integer(Message.Header.From.AppId));

              Text_IO.Put(" ");

              Int_IO.Put(Integer(Message.Header.From.ComId));

              Text_IO.Put(" ");

              Int_IO.Put(Integer(Message.Header.To.AppId));

              Text_IO.Put(" ");

              Int_IO.Put(Integer(Message.Header.To.ComId));

              Text_IO.Put(" Topic ");

              Int_IO.Put(Integer(Topic.Id_Type'pos(Message.Header.Id.Topic)));

              Text_IO.Put(" ");

              Int_IO.Put(Integer(Topic.Extender_Type'pos(Message.Header.Id.Ext)));

              Text_IO.Put_Line(" ");

            end if;

          end if;

        end if; -- Ignore

      end loop;

    end if;

  end Publish; -- (from remote)

  procedure Publish

  ( RemoteAppId : in Itf.Int8;

    Message     : in out Itf.MessageType

  ) is

    Found : Boolean;

  begin -- Publish

    -- Forward Message to instance of Transmit to send to the Remote App

    Found := Component.TransmitWrite( RemoteAppId,

                                      Message );

  end Publish;

  procedure Publish

  ( TopicId      : in Topic.TopicIdType;

    ComponentKey : in Itf.ParticipantKeyType;

    Message      : in String

  ) is

  begin -- Publish

    -- forward for treatment

    Publish(TopicId, ComponentKey, Component.NullKey, Message);

  end Publish;

  procedure Publish

  ( TopicId      : in Topic.TopicIdType;

    ComponentKey : in Itf.ParticipantKeyType;

    From         : in Itf.ParticipantKeyType;

    Message      : in String

  ) is

    Consumers : Library.TopicTableType;

    Found     : Boolean;

    Length    : Integer := 0;

    RequestConsumers : Library.TopicTableType;

    RequestTopic : Topic.TopicIdType;

    Msg : Itf.MessageType;

    use type Itf.Int8;

    use type Itf.Int16;

    use type System.Address;

    use type Topic.Extender_Type;

  begin -- Publish

    -- Increment the reference number associated with all new messages

    ReferenceNumber := ReferenceNumber + 1;

    -- Initialize an instance of a message

    Msg.Header.CRC := 0;

    Msg.Header.Id := TopicId;

    Msg.Header.From := ComponentKey;

    Msg.Header.To := From;

    Msg.Header.ReferenceNumber := ReferenceNumber;

    Found := False;

    for I in 1..Itf.Int16(Message'Length) loop

      Length := Integer(I);

      Msg.Data(Length) := Message(Length);

      Msg.Header.Size := I; -- in case there is no NUL

      if Message(Length) = ASCII.NUL then

        Found := True;

        Msg.Header.Size := I-1;

        exit; -- loop

      end if;

    end loop;

    if not Found then -- need to add trailing NUL in case message sent to C#

      Msg.Data(Length+1) := ASCII.NUL;

    end if;

    -- Get the set of consumers of the topic

    Consumers := Library.TopicConsumers(TopicId);

    RequestTopic := TopicId;

    if TopicId.Ext = Topic.RESPONSE then -- the message has to be delivered

                                         --   to the particular requestor

      -- Get the consumer of the request topic

      RequestTopic.Ext := Topic.REQUEST;

      RequestConsumers := Library.TopicConsumers(RequestTopic);

      if Component.CompareParticipants(Msg.Header.To, Component.NullKey) then

        Text_IO.Put_Line("ERROR: No 'To' address for Response");

        return;

      end if;

      if Msg.Header.To.AppId /= Itf.ApplicationId.Id then

        -- send to remote application

        Publish(Msg.Header.To.AppId, Msg);

        return;

      end if;

      PublishResponseToRequestor(TopicId, Consumers, Msg);

    elsif TopicId.Ext = Topic.REQUEST then -- only one consumer possible

      if Consumers.Count > 0 then

        -- forward request to the lone consumer of request topic

        Msg.Header.To := Consumers.List(1).ComponentKey;

        Consumers.List(1).Requestor := ComponentKey;

        Consumers.List(1).ReferenceNumber := ReferenceNumber;

        if Msg.Header.To.AppId /= Itf.ApplicationId.Id then

          -- send to remote app

          Publish(Msg.Header.To.AppId, Msg);

        else -- forward to local consumer

          Found := Component.DisburseWrite( Consumers.List(1).ComponentKey,

                                            Msg );

          if not Found then

            Text_IO.Put_Line("ERROR: Delivery didn't have queue for request");

          end if;

        end if;

      else

        Text_IO.Put_Line("ERROR: Delivery couldn't find consumer for request");

      end if;

    else -- the published topic has to be the Default - can be multiple consumers

      for I in 1..Consumers.Count loop

        Msg.Header.To := Consumers.List(I).ComponentKey;

        -- Avoid sending topic back to the remote app that transmitted it to

        -- this app or forwarding a remote message that is to be delivered to

        -- a different component.

        if Ignore(Msg, Consumers.List(I).ComponentKey) then

          null; -- ignore

        else -- publish to local or remote component

          if Msg.Header.To.AppId /= Itf.ApplicationId.Id then

            -- Deliver message to remote application

            Publish(Msg.Header.To.AppId, Msg);

          else -- Deliver message to local application by copying to

               -- consumer's queue

            Consumers.List(I).Requestor := ComponentKey;

            Consumers.List(I).ReferenceNumber := 0;

            Found := Component.DisburseWrite( Consumers.List(I).ComponentKey,

                                              Msg );

            if not Found then

              Text_IO.Put_Line(

                "ERROR: local default Delivery couldn't find queue for consumer");

            end if;

          end if;

        end if; -- Ignore

      end loop;

    end if;

  end Publish;

end Delivery;

Library had the treatment of topics necessary for communication with remote applications added from the last time it was published.  This is in conjunction with Format to encode and decode the messages.  Also there is the new ability to know when a Framework topic is allowed and when it no longer is allowed.

Library.ads

with Component;

with Configuration;

with Delivery;

with Itf;

with Topic;

package Library is

  -- A library of registered message topics with their producer

  -- and consumer components.

  -- Possible results of attempt to register a topic

  type AddStatus

  is ( SUCCESS,   -- Topic added to the library

       DUPLICATE, -- Topic already added for the component

       FAILURE,   -- Topic not added

       NOTALLOWED -- Topic not allowed, such as for second consumer of REQUEST

     );

  -- Component data from registration as well as run-time status

  type TopicDataType

  is record

    Id              : Topic.TopicIdType;

    -- complete topic identifier

    ComponentKey    : Itf.ParticipantKeyType;

    -- component that produces the topic

    Distribution    : Delivery.DistributionType;

    -- whether consumed or produced

    fEntry          : Topic.CallbackType;

    -- callback, if any to consume the messages

    Requestor       : Itf.ParticipantKeyType;

    -- component that produced REQUEST topic

    ReferenceNumber : Itf.Int32;

    -- reference number of a REQUEST topic

  end record;

  type TopicTableArrayType

  is array(1..Configuration.MaxApplications*Component.MaxComponents)

  of TopicDataType;

  type TopicTableType

  is record

    Count : Integer;

    -- Number of declared topics of the configuration of applications

    List  : TopicTableArrayType;

  end record;

  -- Data of Remote Request topic

  type TopicListDataType

  is record

    TopicId      : Topic.TopicIdType;

    ComponentKey : Itf.ParticipantKeyType;

  end record;

  -- List of topics

  type TopicListTableArrayType

  is array(1..25)

  of TopicListDataType;

  type TopicListTableType

  is record

    Count : Integer;

    List  : TopicListTableArrayType;

  end record;

  procedure Initialize;

  function RegisterTopic

  ( Id           : in Topic.TopicIdType;

    ComponentKey : in Itf.ParticipantKeyType;

    Distribution : in Delivery.DistributionType;

    fEntry       : in Topic.CallbackType

  ) return AddStatus;

  procedure RegisterRemoteTopics

  ( RemoteAppId : in Itf.Int8;

    Message     : in Itf.MessageType

  );

  procedure RemoveRemoteTopics

  ( RemoteAppId : in Itf.Int8

  );

  -- Send the Register Request message to the remote app.

  procedure SendRegisterRequest

  ( RemoteAppId : in Itf.Int8

  );

  function TopicConsumers

  ( Id : in Topic.TopicIdType

  ) return TopicTableType;

  -- Determine if supplied topic is a known pairing.

  function ValidPairing

  ( Id : in Topic.TopicIdType

  ) return Boolean;

end Library;

Library.adb

with App;

with Format;

with Itf;

with System;

with Text_IO;

with Topic;

package body Library is

  package Int_IO is new Text_IO.Integer_IO( Integer );

  -- Library of topic producers and consumers

  TopicTable : TopicTableType;

  type CallbackDataType

  is record

    cEntry : Topic.CallbackType; -- Any entry point to consume the message

  end record;

  type CallbackDataArrayType

  is array(1..Component.MaxComponents) of CallbackDataType;

  type CallbackTableType

  is record

    Count : Integer;

    List  : CallbackDataArrayType;

  end record;

  procedure SendRegisterResponse

  (RemoteAppId : in Itf.Int8);

  procedure Initialize is

  begin -- Initialize

    TopicTable.Count := 0;

  end Initialize;

  -- Add a topic with its component, whether producer or consumer, and entry for consumer

  function RegisterTopic

  ( Id           : in Topic.TopicIdType;

    ComponentKey : in Itf.ParticipantKeyType;

    Distribution : in Delivery.DistributionType;

    fEntry       : in Topic.CallbackType

  ) return AddStatus is

    EntryFound

    : Boolean;

    use type Delivery.DistributionType;

    use type System.Address;

    use type Topic.Extender_Type;

    use type Topic.Id_Type;

  begin -- RegisterTopic

    -- Determine if supplied topic is a known pairing.

    EntryFound := ValidPairing(Id);

    if (not EntryFound) then

      return NOTALLOWED;

    end if;

    -- Determine if a framework topic.  That is, a user component shouldn't be

    -- registering these topics to the Library.

    if (Id.Topic in Topic.NONE..Topic.REGISTER or else

        Id.Ext = Topic.FRAMEWORK) and then

       not App.FrameworkTopicsAllowed

    then

      return NOTALLOWED;

    end if;

    -- Determine if topic has already been added to the library.

    -- Note: A REQUEST message of a particular Topic should only be registered

    --       for one consumer.  Delivery will only route the REQUEST to one

    --       consumer.  That is, REQUEST messages are paired with a RESPONSE

    --       message with only one component to be designated to produce the

    --       RESPONSE.  There can be multiple requestors and the response will

    --       be delivered to the requesting component.

    EntryFound := False;

    for I in 1..TopicTable.Count loop

      if Id.Topic = TopicTable.List(I).Id.Topic then -- topic id already in table

        -- Be sure this new registration isn't for a second request consumer

        if (Id.Ext = TopicTable.List(I).Id.Ext and then

            Id.Ext = Topic.REQUEST and then

            Distribution = Delivery.CONSUMER)

        then

          if not Component.CompareParticipants -- different components

             ( ComponentKey,

               TopicTable.List(I).ComponentKey ) and then

             TopicTable.List(I).Distribution = Delivery.CONSUMER -- 2nd Consumer

          then

            EntryFound := True;

            return NOTALLOWED;

          end if;

        end if;

      end if; -- topic in table

    end loop;

    -- Check that consumer component has a queue

    if Distribution = Delivery.CONSUMER then

      for K in 1..Component.ComponentTable.Count loop

        if Component.CompareParticipants(

             ComponentKey, Component.ComponentTable.List(K).Key)

        then

          if Component.ComponentTable.List(K).Queue = System.Null_Address then

            return NOTALLOWED;

          end if;

        end if;

      end loop;

    end if;

    if not EntryFound then -- add the topic with its component to the table

      declare

        K : Integer := TopicTable.Count + 1;

      begin

        TopicTable.List(K).Id := Id;

        TopicTable.List(K).ComponentKey := ComponentKey;

        TopicTable.List(K).Distribution := Distribution;

        TopicTable.List(K).fEntry := fEntry;

        TopicTable.Count := K;

        return SUCCESS;

      end;

    end if;

    return FAILURE;

  end RegisterTopic;

  procedure RegisterRemoteTopics

  ( RemoteAppId : in Itf.Int8;

    Message     : in Itf.MessageType

  ) is

    Index  : Integer;

    Topics : Library.TopicListTableType;

    use type Itf.Int8;

  begin -- RegisterRemoteTopics

    -- Check if topics from remote app have already been registered.

    for I in 1..TopicTable.Count loop

      if TopicTable.List(I).ComponentKey.AppId = RemoteAppId then

        Text_IO.Put_Line("RegisterRemoteTopics already in table");

        -- Send Response to the remote app again.

        SendRegisterResponse(RemoteAppId);

        return; -- since TopicTable already contains entries from remote app

      end if;

    end loop;

    -- Decode Register Request topic.

    Topics := Format.DecodeRegisterRequestTopic(Message);

    -- Add the topics from remote app as ones that it consumes.

    Index := TopicTable.Count + 1;

    for I in 1..Topics.Count loop

      -- Ignore local consumer being returned in Register Request

      if Topics.List(I).ComponentKey.AppId /= Itf.ApplicationId.Id then

        TopicTable.List(Index).Id := Topics.List(I).TopicId;

        Text_IO.Put("RegisterRequest topic");

        Int_IO.Put(Index);

        Int_IO.Put(Topic.Id_Type'pos(TopicTable.List(Index).Id.Topic));

        Int_IO.Put(Topic.Extender_Type'pos(TopicTable.List(Index).Id.Ext));

        Text_IO.Put(" ");

        Int_IO.Put(Index);

        Int_IO.Put(Topic.Id_Type'pos(TopicTable.List(Index).Id.Topic));

        Int_IO.Put(Topic.Extender_Type'pos(TopicTable.List(Index).Id.Ext));

        TopicTable.List(Index).ComponentKey.AppId := Topics.List(I).ComponentKey.AppId;

        TopicTable.List(Index).ComponentKey.ComId := Topics.List(I).ComponentKey.ComId;

        TopicTable.List(Index).ComponentKey.SubId := Topics.List(I).ComponentKey.SubId;

        TopicTable.List(Index).Distribution := Delivery.CONSUMER;

        TopicTable.List(Index).fEntry := null;

        TopicTable.List(Index).Requestor.AppId := Itf.Int8(RemoteAppId);

        TopicTable.List(Index).Requestor.ComId := 0; -- add for Request message

        TopicTable.List(Index).Requestor.SubId := 0; --  sometime

        TopicTable.List(Index).ReferenceNumber := 0;

        Index := Index + 1;

        TopicTable.Count := Index;

      else

        Text_IO.Put("ERROR: Register Request contains local component");

        Int_IO.Put(Integer(Topics.List(I).ComponentKey.AppId));

        Int_IO.Put(Integer(Topics.List(I).ComponentKey.ComId));

        Text_IO.Put(" ");

      end if;

    end loop;

    Text_IO.Put_Line("TopicTable after Decode");

    -- Send Response to the remote app.

    SendRegisterResponse(RemoteAppId);

  end RegisterRemoteTopics;

  procedure RemoveRemoteTopics

  ( RemoteAppId : in Itf.Int8

  ) is

    NewCount : Integer := TopicTable.Count;

    Index    : Integer := TopicTable.Count;

    NewIndex : Integer;

    use type Itf.Int8;

  begin -- RemoveRemoteTopics

    Text_IO.Put("RemoveRemoteTopics count=");

    Int_IO.Put(TopicTable.Count);

    Text_IO.Put(" RemoteAppId");

    Int_IO.Put(Integer(RemoteAppId));

    Text_IO.Put_Line(" ");

    -- Actually working backwards so will only have topics from another

    -- remote app to move up to replace those of the disconnected app.

    for I in 1..TopicTable.Count loop

      if (TopicTable.List(Index).ComponentKey.AppId = RemoteAppId) then

        Text_IO.Put("RemoteTopic in Library table");

        Int_IO.Put(Topic.Id_Type'pos(TopicTable.List(Index).Id.Topic));

        Int_IO.Put(Topic.Extender_Type'pos(TopicTable.List(Index).Id.Ext));

        Text_IO.Put_Line(" ");

        -- Move up any entries that are after this one

        NewIndex := Index;

        for J in Index+1..NewCount loop

          TopicTable.List(NewIndex) := TopicTable.List(J);

          NewIndex := NewIndex + 1;

        end loop;

        NewCount := NewIndex;

      end if;

      Index := Index - 1;

    end loop;

    TopicTable.Count := NewCount;

    Text_IO.Put("TopicTable after Decode");

    Int_IO.Put(TopicTable.Count);

    Text_IO.Put_Line(" ");

    for I in 1..TopicTable.Count loop

      Int_IO.Put(I);

      Int_IO.Put(Topic.Id_Type'pos(TopicTable.List(Index).Id.Topic));

      Int_IO.Put(Topic.Extender_Type'pos(TopicTable.List(Index).Id.Ext));

      Int_IO.Put(Integer(TopicTable.List(I).ComponentKey.AppId));

      Int_IO.Put(Integer(TopicTable.List(I).ComponentKey.ComId));

      Text_IO.Put_Line(" ");

    end loop;

  end RemoveRemoteTopics;

  -- Send the Register Request message to the remote app.  This

  -- message is to contain the topics of the local app for which

  -- there are consumers so that the remote app will forward

  -- any of those topics that it publishes.

  procedure SendRegisterRequest

  ( RemoteAppId : in Itf.Int8

  ) is

    Message : Itf.MessageType;

    TopicConsumers : TopicTableType;

    use type Delivery.DistributionType;

    use type Itf.Int8;

    use type Topic.Extender_Type;

    use type Topic.Id_Type;

  begin -- SendRegisterRequest

    -- Build table of all non-framework topics that have local consumers.

    TopicConsumers.Count := 0;

    for I in 1..TopicTable.Count loop

      if TopicTable.List(I).Id.Topic /= Topic.REGISTER and then

         TopicTable.List(I).Id.Ext /= Topic.FRAMEWORK

      then

        if TopicTable.List(I).Distribution = Delivery.CONSUMER and then

           TopicTable.List(I).ComponentKey.AppId = Itf.ApplicationId.Id

        then

          Text_IO.Put("RegisterRequest");

          Int_IO.Put(Integer(TopicTable.List(I).ComponentKey.AppId));

          Int_IO.Put(Topic.Id_Type'pos(TopicTable.List(I).Id.Topic));

          Int_IO.Put(Topic.Extender_Type'pos(TopicTable.List(I).Id.Ext));

          Text_IO.Put_Line(" ");

          TopicConsumers.Count := TopicConsumers.Count + 1;

          TopicConsumers.List(TopicConsumers.Count) := TopicTable.List(I);

        end if;

      end if;

    end loop;

    -- Build Register Request topic of these topics.

    Message := Format.RegisterRequestTopic(RemoteAppId, TopicConsumers);

    Text_IO.Put_Line("Publish of Register Request");

    Delivery.Publish(RemoteAppId, Message);

    -- if this works then Format doesn't really need to fill in header.

    -- or do a new Publish for this.

  end SendRegisterRequest;

  procedure SendRegisterResponse

  ( RemoteAppId : in Itf.Int8

  ) is

    ResponseMessage : Itf.MessageType;

  begin  -- SendRegisterResponse

    ResponseMessage.Header.CRC := 0;

    ResponseMessage.Header.Id.Topic := Topic.REGISTER;

    ResponseMessage.Header.Id.Ext := Topic.RESPONSE;

    ResponseMessage.Header.From := Component.NullKey;

    ResponseMessage.Header.From.AppId := Itf.ApplicationId.Id;

    ResponseMessage.Header.To := Component.NullKey;

    ResponseMessage.Header.To.AppId := RemoteAppId;

    ResponseMessage.Header.ReferenceNumber := 0;

    ResponseMessage.Header.Size := 0;

    ResponseMessage.Data(1) := ' ';

    Delivery.Publish( RemoteAppId, ResponseMessage );

  end SendRegisterResponse;

  -- Return list of callback consumers

  function Callbacks

  ( Id : in Itf.ParticipantKeyType

  ) return CallbackTableType is

    EntryPoints : CallbackTableType;

    use type Topic.CallbackType;

  begin -- Callbacks

    EntryPoints.Count := 0;

    for I in 1..TopicTable.Count loop

      if ((Component.CompareParticipants(TopicTable.List(I).ComponentKey, Id))

      and then

          (TopicTable.List(I).fEntry /= null))

      then

        EntryPoints.List(EntryPoints.Count).cEntry := TopicTable.List(I).fEntry;

        EntryPoints.Count := EntryPoints.Count + 1;

      end if;

    end loop;

    return EntryPoints;

  end Callbacks;

  -- Return list of consumers of the specified topic

  function TopicConsumers

  ( Id : in Topic.TopicIdType

  ) return TopicTableType is

    --debug

    Heartbeat : Boolean := False;

    TopicConsumers : TopicTableType;

    use type Delivery.DistributionType;

    use type Topic.Extender_Type;

    use type Topic.Id_Type;

  begin -- TopicConsumers

    if (Id.Topic = Topic.HEARTBEAT) then

      Heartbeat := True;

    end if;

    TopicConsumers.Count := 0;

    for I in 1..TopicTable.Count loop

      if ((Id.Topic = TopicTable.List(I).Id.Topic) and then

          (Id.Ext = TopicTable.List(I).Id.Ext))

      then

        if (TopicTable.List(I).Distribution = Delivery.CONSUMER) then

          --  if (Heartbeat) then

             --  Console.Write("Consume Heartbeat {0} {1}",

             --                    TopicTable.List(I).Component.AppId,

             --                    TopicTable.List(I).Component.ComId);

          --  end if;

          TopicConsumers.Count := TopicConsumers.Count + 1;

          TopicConsumers.List(TopicConsumers.Count) := TopicTable.List(I);

        end if;

      end if;

    end loop;

    return TopicConsumers;

  end TopicConsumers;

  function ValidPairing

  ( Id : in Topic.TopicIdType

  ) return Boolean is

    use type Topic.Id_Type;

    use type Topic.Extender_Type;

  begin -- ValidPairing

    for I in 1..Topic.TopicIds.Count loop

      if ((Id.Topic = Topic.TopicIds.List(I).Topic) and then -- then known

          (Id.Ext = Topic.TopicIds.List(I).Ext)) then        --   topic pairing

        return True;

      end if;

    end loop;

    return False;

  end ValidPairing;

end Library;

Format.ads

with Itf;

with Library;

package Format is

  procedure Initialize;

  function DecodeHeartbeatMessage

  ( Message     : in Itf.MessageType;

    RemoteAppId : in Itf.Int8

  ) return Boolean;

  function DecodeRegisterRequestTopic

  ( Message : in Itf.MessageType

  ) return Library.TopicListTableType;

  function EncodeHeartbeatMessage

  ( RemoteAppId : in Itf.Int8

  ) return Itf.MessageType;

  function RegisterRequestTopic

  ( AppId     : in Itf.Int8;

    Consumers : in Library.TopicTableType

  ) return Itf.MessageType;

 end Format;

Format.adb

with Component;

with CStrings;

with Itf;

with System;

with Text_IO;

with Topic;

package body Format is

  package Int_IO is new Text_IO.Integer_IO( Integer );

  HeartbeatIteration : Integer := 0;

  procedure Initialize is

  begin -- Initialize

    null;

  end Initialize;

  function DecodeHeartbeatMessage

  ( Message     : in Itf.MessageType;

    RemoteAppId : in Itf.Int8

  ) return Boolean is

    I : CStrings.StringOffsetType;

    -- Index into string

    J : CStrings.CompareResultType;

    -- 0 if two strings compare

    L : CStrings.StringOffsetType;

    -- Length of substring

    Msg

    : CStrings.StringType := Message.Data'Address;

    use type Itf.Int16;

    use type Topic.Extender_Type;

    use type Topic.Id_Type;

  begin -- DecodeHeartbeatMessage

    if Message.Header.Id.Topic /= Topic.HEARTBEAT or else

       Message.Header.Id.Ext /= Topic.FRAMEWORK

    then

      Text_IO.Put_Line("Heartbeat message Topic invalid ");

      return False;

    end if;

    -- assuming rest of header is ok

    if Message.Header.Size /= 15 then

      Text_IO.Put("Heartbeat message has a size other than 15 ");

      Int_IO.Put(Integer(Message.Header.Size));

      Text_IO.Put_Line(" ");

      return False;

    end if;

    -- Find first delimiter, if any.

    I := CStrings.IndexOf1(Msg, '|');

    L := 0;

    if I > 0 then -- delimiter found

      -- Is substring prior to delimiter the message id?

      declare

        SubString1

        -- String where NUL will be located at position corresponding to '|'

        : String(1..I);

        Heartbeat : String(1..10);

      begin

        SubString1 := CStrings.Substring(Msg, 1, I-1); -- string prior to '|'

        SubString1(I) := ASCII.NUL;

        Heartbeat(1..9) := "Heartbeat";

        Heartbeat(10) := ASCII.NUL;

        J := CStrings.Compare(Substring1'Address, Heartbeat'Address, False);

        if J /= 0 then

          -- miscompare

          return False; -- not Heartbeat message

        end if;

      end;

    else

      return False; -- not Heartbeat message

    end if;

    -- Heartbeat message

    L := Integer(Message.Header.Size) - I + 1; -- where I is location of the '|'

    declare

      SubString1 : String(1..L);

      -- String where NUL will be located at position corresponding to '|'

      Msg1 : CStrings.StringType := CStrings.AddToAddress(Msg,I);

    begin

      SubString1 := CStrings.Substring(Msg1, 1, L-1);

      SubString1(L) := ASCII.NUL;

      I := CStrings.IndexOf1(SubString1'Address,'|');

      declare

        Numeric    : String(1..I);

        SubString2 : String(1..SubString1'Length-I+1);

        Field      : Integer;

        Result     : Boolean;

        Msg2       : CStrings.StringType := CStrings.AddToAddress(Msg1,I);

      begin

        Numeric := CStrings.Substring(SubString1'Address, 1, I-1);

        Numeric(I) := ASCII.NUL;

        L := SubString1'Length - I -1;

        CStrings.TryParse(Numeric'Address, Numeric'Length, Field, Result);

        if not Result then

          return False;

        end if;

        if Field /= Integer(RemoteAppId) then -- 1st field not as expected

          return False;

        end if;

        -- Get "to" app id

        SubString2 := CStrings.SubString(Msg2, 1, L+1);

        SubString2(L) := ASCII.NUL;

        I := CStrings.IndexOf1(SubString2'Address,'|');

        Numeric := CStrings.Substring(SubString2'Address, 1, I-1);

        Numeric(I) := ASCII.NUL;

        L := SubString1'Length - I -1;

        CStrings.TryParse(Numeric'Address, Numeric'Length, Field, Result);

        if not Result then

          return False;

        end if;

        if Field /= Integer(Itf.ApplicationId.Id) then -- 2nd field not as expected

          return False;

        end if;

        -- Get Heartbeat Iteration.  Otherwise ignore it for now.

--        declare

--          SubString3 : String(1..SubString2'Length-I);--width with up to | removed

--          Msg3 : CStrings.StringType := CStrings.AddToAddress(Msg2,I);

--        begin

--          SubString3 := CStrings.SubString(Msg3, 1, L+1);

--        end;

      end;

    end;

    return True;

  end DecodeHeartbeatMessage;

  function EncodeHeartbeatMessage

  ( RemoteAppId : in Itf.Int8

  ) return Itf.MessageType is

    Success : Boolean;

    Id      : String(1..2);

    Message : Itf.MessageType; -- message to be returned

    Msg : String(1..25) := (others => ASCII.NUL); -- enough space for Data

    for Msg use at Message.Data'address;

  begin -- EncodeHeartbeatMessage

    Msg(1..10) := "Heartbeat|";

    CStrings.IntegerToString( Integer(Itf.ApplicationId.Id), 1, True, Id, Success );

    Msg(11) := Id(1);

    Msg(12..12) := "|";

    CStrings.IntegerToString( Integer(RemoteAppId), 1, True, Id, Success );

    Msg(13) := Id(1);

    Msg(14..14) := "|";

    CStrings.IntegerToString( HeartbeatIteration, 1, True, Id, Success );

    Msg(15) := Id(1);

    Message.Header.CRC := 0;

    Message.Header.Id.Topic := Topic.HEARTBEAT;

    Message.Header.Id.Ext := Topic.FRAMEWORK;

    Message.Header.From.AppId := Itf.ApplicationId.Id;

    Message.Header.From.ComId := 0;

    Message.Header.From.SubId := 0;

    Message.Header.To.AppId := RemoteAppId;

    Message.Header.To.ComId := 0;

    Message.Header.To.SubId := 0;

    Message.Header.ReferenceNumber := 0;

    Message.Header.Size := 15;

    return Message;

  end EncodeHeartbeatMessage;

  function DecodeRegisterRequestTopic

  ( Message : in Itf.MessageType

  ) return Library.TopicListTableType is

    Count : Integer;

    Size  : Integer;

    Index : Integer;

    I     : Integer;

    TopicData : Library.TopicListTableType;

    Msg : String(1..Integer(Message.Header.Size)+1); -- +1 for trailing NUL

    for Msg use at Message.Data'Address;

  begin -- DecodeRegisterRequestTopic

    -- Extract size from the message

    Count := (Integer(Message.Header.Size) + 1) / 5; -- bytes per item

    -- Extract topics from the message

    TopicData.Count := 0;

    Size := Integer(Message.Header.Size);

    I := 1;

    Index := 1;

    while Size > 0 loop

      declare

        Id : Topic.Id_Type;

        for Id use at Msg(I)'Address;

        Ext : Topic.Extender_Type;

        for Ext use at Msg(I+1)'Address;

        AId : Itf.Int8;

        for AId use at Msg(I+2)'Address;

        CId : Itf.Int8;

        for CId use at Msg(I+3)'Address;

        SId : Itf.Int8;

        for SId use at Msg(I+4)'Address;

      begin

        TopicData.List(Index).TopicId.Topic := Id;

        TopicData.List(Index).TopicId.Ext := Ext;

        TopicData.List(Index).ComponentKey.AppId := AId;

        TopicData.List(Index).ComponentKey.ComId := CId;

        TopicData.List(Index).ComponentKey.SubId := SId;

      end;

      Index := Index + 1;

      TopicData.Count := TopicData.Count + 1;

      I := I + 5;

      Size := Size - 5;

    end loop;

    return TopicData;

  end DecodeRegisterRequestTopic;

  function RegisterRequestTopic

  ( AppId     : in Itf.Int8;

    Consumers : in Library.TopicTableType

  ) return Itf.MessageType is

    Index : Integer;

    Key : Itf.ParticipantKeyType;

    Message : Itf.MessageType;

    Msg : String(1..200); -- sufficient size

    for Msg use at Message.Data'Address;

    use type Topic.Id_Type;

  begin -- RegisterRequestTopic

    Key.AppId := Itf.ApplicationId.Id;

    Key.ComId := 0; -- for

    Key.SubId := 0; --   Framework

    Message.Header.CRC := 0;

    Message.Header.Id.Topic := Topic.REGISTER;

    Message.Header.Id.Ext := Topic.REQUEST;

    Message.Header.From := Key;

    Key.AppId := Itf.Int8(AppId);

    Message.Header.To := Key;

    Message.Header.ReferenceNumber := 0;

    Index := 1;

    for I in 1..Consumers.Count loop

      if Consumers.List(I).Id.Topic /= Topic.ANY and then      -- don't

         Consumers.List(I).Id.Topic /= Topic.REGISTER and then --  include

         Library.ValidPairing(Consumers.List(I).Id)

      then

        declare

          Id : Topic.Id_Type;

          for Id use at Msg(Index)'Address;

          Ext : Topic.Extender_Type;

          for Ext use at Msg(Index+1)'Address;

          AId : Itf.Int8;

          for AId use at Msg(Index+2)'Address;

          CId : Itf.Int8;

          for CId use at Msg(Index+3)'Address;

          SId : Itf.Int8;

          for SId use at Msg(Index+4)'Address;

        begin

          Id := Consumers.List(I).Id.Topic;

          Ext := Consumers.List(I).Id.Ext;

          AId := Consumers.List(I).ComponentKey.AppId;

          CId := Consumers.List(I).ComponentKey.ComId;

          SId := Consumers.List(I).ComponentKey.SubId;

        end;

        Index := Index + 5;

      else

        Text_IO.Put_Line("RegisterRequestTopic Invalid Pairing");

      end if;

    end loop;

    Msg(Index) := ASCII.NUL; -- append terminating NUL

    Message.Header.Size := Itf.Int16(Index-1);

    return Message;

  end RegisterRequestTopic;

end Format;

Debugging/Testing

While testing/debugging I created a configuration of 4 applications – the maximum allowed at the present time – and added a third application (a duplicate of the first) to send the OFP KEYPUSH to the second application.  Various text output was added to attempt to track what was happening.  To capture this output DOS windows were opened and the output was piped (i.e., the > operator is used) to files for each application.  Although frequently the output became intermixed due to the thread being suspended before the output was finished so output from another thread would appear and have to be interpreted.  Or at least that's my opinion based upon my years of past experience.  (I had forgotten that Critical Region is how I had locked the thread in the past.) 

Only a small amount of this text output was retained in the code presented in this post.

This testing succeeded with communications between applications 1 and 2 and between 3 and 2 while attempting to open a connection to the non-existent application 4.  Other configurations of 2 applications and three applications were also used.

In any case, messages were transmitted by one application and the other application would receive and treat the message.  However, the received message wouldn't go any further and I would need to add text output to find how far the treatment of the message had gotten to locate where the error was located so that it could be corrected.  The statements to track down this type of mistake have all been removed.