Saturday, February 23, 2019

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.



No comments: