Thursday, January 17, 2019

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


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

Following along with the translation of the C# message delivery framework to Ada of the previous two posts, I am again reporting my progress.

The Disburse package that implements the delivery queue was added.  The Disburse package directly follows the Disburse class of C# except for a couple of modifications that will eventually be made to the C# class. 

The Component package that was used in the prior post but not reported will also be provided along with the and Configuration package.

Disburse

The C# Disburse class has a different instance for each component that consumes message topics.  In Ada this is a known as a generic package where a different instance of the generic is instantiated each time it is used.

While translating the Disburse class to the Ada package, it occurred to me that its Forward Message feature could leave untreated message topics to be consumed by a component that were not in its Forward Table.  That is, the component would need to provide message callbacks for the topics in its Forward Table but could neglect to treat messages for which no message callback was provided.  This could be handled by having its main method forever loop check for unread messages in its queue.  However, this could cause a message with a message callback being read via the forever loop.  Then it would be treated from two different methods; that of the message callback and the forever loop.

Therefore, I added a Universal message callback so that the Forward Message feature would invoke it if the dequeued message wasn't one with a topic in the Forward Table.  That is, such messages will now be treated in a general message callback for any message topics not included for individual treatment.

In addition, although minor, the Disburse class Write method signals the component to wakeup to treat the new message whether or not it is a periodic component.  That is, a periodic component will have its own PeriodicTimer wakeup event and signal the wakeup when the period has elapsed.  Having the Write method also signal a wakeup means that the specified period will not have elapsed when its forever loop is signaled to do its processing.  Therefore, I passed to the particular instance of the Disburse Ada package whether the component is periodic and have its Write procedure avoid signaling a wakeup when the component is periodic.

These two changes will need to be made to the C# class.

The C# class constructor is implemented in the Ada package body via an instantiation procedure.  That is, there is a special Ada feature where code can be added via an unnamed procedure at the end of the package body.  This could have been done using a named Initialization procedure but I choose to use the instantiation procedure to illustrate this Ada feature.  I retained this even though I still had to add an initialization procedure to pass the Wait event handle.  This latter because there is a chicken and egg problem where the component has to be registered to obtain the wait event handle and the instance of the Disburse package has to be also be passed to register the component.  So I named this particular initialization procedure ProvideWaitEvent and have invoked it immediately following the Component Register it each of my dummy test components.

In spit of there now being a forward message feature for every message, the message is queued in the Write procedure since that allows for the extremely unlikely situation of multiple higher priority threads delivering messages while the lower priority  component is suspended somewhere in the middle of treating a message.  Also because the message won't be treated until the end of the interval for periodic components so multiple messages can be received during the interval.  If the queue is not for a periodic component, the end of the wait is signaled to the component.  The wait handling itself is implemented within the instance of the queue and is invoked from the component's forever loop.  This EventWait procedure waits for the event (the event that Write or PeriodicTimer signals) and then resets it to start another wait.  It next invokes ForwardMessage to read and treat all the messages in the queue.  (Note: Likely there will be only one.)

ForwardMessage has a read loop that reads each message from the queue and forwards it to its message callback.  If there is a forward table (non-null ForwardPtr) the forward table is searched for the topic of the message.  If a match occurs, the message callback of the topic is invoked passing the message to it.  This callback will be a procedure in the component that reads the message and acts on it.  It the table doesn't contain a topic matching that of the message or if the component didn't supply a table, the Universal message callback of the component is invoked passing the message.  Like the individual message callbacks, this callback, after determining the topic of the message, must act on the message.

To help ensure that a Universal message callback is provided something must be specified for it when the generic package is instantiated.  (Again, the C# Disburse class will need some changes.)

Disburse.cs

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading;

namespace VisualCompiler
{
    public class Disburse
    {
        public string queueName;

        public struct DisburseDataType
        {
            public Topic.TopicIdType topic;
            public Forward forward;
        }

        private int iteration = 0;

        // Queued items will be removed from the queue as they are read.
        public struct QueueDataType // Queued topic messages
        {
            public Delivery.MessageType message;
        };

        int size = 10;
        private class QueueType
        {
            public string name; // Name given to the queue by the component
            public bool wait;
            public bool unread;
            public int nextReadIndex;
            public int nextWriteIndex;
            public QueueDataType[] list = new QueueDataType[10]; // i.e., size
        };

        static private EventWaitHandle waitHandle;

        private QueueType queue = new QueueType();

        public Disburse() // constructor
        {
        }

        public Disburse(string name, bool waitEvent) // constructor
        {
            queueName = name;
            queue.name = name;
            queue.wait = waitEvent;
            queue.unread = false;
            queue.nextReadIndex = 0;
            queue.nextWriteIndex = 0;

            // create the wait handle
            waitHandle =
                new EventWaitHandle(false, EventResetMode.ManualReset);
        } // end constructor Disburse

        public EventWaitHandle QueueWaitHandle()
        {
            return waitHandle;
        } // end QueueWaitHandle

        // Wait for the event issued by Write.
        public virtual void EventWait()
        {
            iteration++;
            // Reset the wait handle
            bool signaled = false;
            bool waitResult = false;
            waitHandle.Reset(); // reset the wait handle

            // Wait for the event to be signaled.
            signaled = waitHandle.WaitOne(Timeout.Infinite, waitResult);

        } // end


        // Clear the queue if case don't want to instantiate the queue again
        public virtual void Clear()
        {
            queue.unread = false;
            queue.nextReadIndex = 0;
            queue.nextWriteIndex = 0;
        } // end Clear

        public virtual Delivery.MessageType Read()
        {
            bool rtnNone = false;
            int savedReadIndex;
            if (queue.nextReadIndex == queue.nextWriteIndex)
            {
                Console.WriteLine("Disburse Read NRI == nWI");
                queue.unread = false;
                rtnNone = true;
            }
            savedReadIndex = queue.nextReadIndex;
            if ((queue.nextReadIndex + 1) >= size)
            {
                queue.nextReadIndex = 0;
            }
            else
            {
                queue.nextReadIndex++;
            }
            if (queue.nextReadIndex == queue.nextWriteIndex)
            {
                queue.unread = false;
            }
            else
            {
                queue.unread = true;
            }
            if (rtnNone)
            {
                return Delivery.nullMessage;
            }
            else
            {
                return queue.list[savedReadIndex].message;
            }
        } // end Read

        public virtual bool Unread()
        {
            return queue.unread;
        } // end Unread

        public virtual bool Write(Delivery.MessageType message)
        {
            bool rtn = true;

            int currentIndex = queue.nextWriteIndex;
            int nextIndex = currentIndex + 1;
            if ((nextIndex) >= size)
            {
                nextIndex = 0;
            }
            if (nextIndex == queue.nextReadIndex)
            { // queue overrun
                Console.WriteLine("ERROR: Disburse {0} overrun", queueName);
                rtn = false;
            }
            if (rtn)
            {
                queue.list[currentIndex].message = message;
                queue.nextWriteIndex = nextIndex;
                queue.unread = true;
                Console.WriteLine("Disburse {0} set unread", queueName);
            }
            if (queue.wait)
            {
                Console.WriteLine("Disburse {0} signal wakeup {1}",
                    queueName, iteration);
                // signal wakeup of the component that instantiated the queue
                waitHandle.Set();
            }
            return rtn;
        } // end Write

    } // end Disburse class

    public class DisburseForward : Disburse
    {
        private int iteration = 0;

        // Table of topics to disburse to their callback
        public class DisburseTableType
        {
            public int count;
            public DisburseDataType[] list = new DisburseDataType[10];
        }

        public DisburseTableType forwardTopicTable = new DisburseTableType();

        const int size = 10;
        private class QueueType
        {
            public string name; // Name given to the queue by the component
            public bool wait;
            public bool unread;
            public int nextReadIndex;
            public int nextWriteIndex;
            public QueueDataType[] list = new QueueDataType[size];
        };

        private QueueType queue = new QueueType();

        static private EventWaitHandle waitHandle;

        public DisburseForward(string name, DisburseTableType table) // constructor
        {
            queueName = name;
            queue.name = name;
            queue.wait = true;
            queue.unread = false;
            queue.nextReadIndex = 0;
            queue.nextWriteIndex = 0;
           
            forwardTopicTable.count = table.count;
            for (int i = 0; i < table.count; i++)
            {
                forwardTopicTable.list[i] = table.list[i];
            }

            // Obtain a wait handle for the component that instantiated the queue
            waitHandle =
               new EventWaitHandle(false, EventResetMode.ManualReset);

        } // end constructor DisburseForward


        private void ForwardMessage()
        {
            int managedThreadId = Thread.CurrentThread.ManagedThreadId;
            Console.WriteLine("Disburse signaled for {0} {1} {2}",
                              queue.name, iteration, managedThreadId);

            Delivery.MessageType message;
            Forward forward = null;

            while (Unread())
            {   // Read message from queue
                message = Read();
                // Lookup callback associated with message topic
                for (int i = 0; i < forwardTopicTable.count; i++)
                {
                    if ((message.header.id.topic ==
                         forwardTopicTable.list[i].topic.topic)
                     && (message.header.id.ext ==
                         forwardTopicTable.list[i].topic.ext))
                    {
                        forward = forwardTopicTable.list[i].forward;
                        break; // exit loop
                    }
                }

                // Invoke the callback passing the received message
                if (forward != null)
                {
                    forward(message);
                }
                else if (forwardTopicTable.count > 0)
                {
                    Console.WriteLine(
                        "ERROR: No forward callback for topic {0} {1} {2}",
                        queueName,
                        message.header.id.topic, message.header.id.ext);
                }
            } // end while
        } // end ForwardMessage

        // Wait for the event issued by Write.
        public override void EventWait()
        {
            iteration++;
            // Reset the wait handle
            bool signaled = false;
            bool waitResult = false;
            waitHandle.Reset(); // reset the wait handle

            // Wait for the event to be signaled.
            signaled = waitHandle.WaitOne(Timeout.Infinite, waitResult);

            if (forwardTopicTable.count > 0)
            {
                ForwardMessage();
            }
        } // end EventWait

        public override void Clear()
        {
            queue.unread = false;
            queue.nextReadIndex = 0;
            queue.nextWriteIndex = 0;
        } // end Clear

        public override Delivery.MessageType Read()
        {
            bool rtnNone = false;
            int savedReadIndex;
            if (queue.nextReadIndex == queue.nextWriteIndex)
            {
                Console.WriteLine("Disburse Read NRI == nWI");
                queue.unread = false;
                rtnNone = true;
            }
            savedReadIndex = queue.nextReadIndex;
            if ((queue.nextReadIndex + 1) >= size)
            {
                queue.nextReadIndex = 0;
            }
            else
            {
                queue.nextReadIndex++;
            }
            if (queue.nextReadIndex == queue.nextWriteIndex)
            {
                queue.unread = false;
            }
            else
            {
                queue.unread = true;
            }
            if (rtnNone)
            {
                return Delivery.nullMessage;
            }
            else
            {
                return queue.list[savedReadIndex].message;
            }
        } // end Read

        public override bool Unread()
        {
            return queue.unread;
        } // end Unread

        public override bool Write(Delivery.MessageType message)
        {
            bool rtn = true;

            int currentIndex = queue.nextWriteIndex;
            int nextIndex = currentIndex + 1;
            if ((nextIndex) >= size)
            {
                nextIndex = 0;
            }
            if (nextIndex == queue.nextReadIndex)
            { // queue overrun
                rtn = false;
            }
            if (rtn)
            {
                string xxx = queue.name;
                queue.list[currentIndex].message = message;
                queue.nextWriteIndex = nextIndex;
                queue.unread = true;
            }
            if (queue.wait)
            {
                // signal wakeup of the component that instantiated the queue
                waitHandle.Set();
            }
            return rtn;
        } // end Write

    } // end DisburseForward class

} // end namespace

Disburse Ada package

with ExecItf;
with Itf;
with System;
with Topic;

generic

  QueueName : System.Address; -- address of name given to queue by component
  Periodic  : Boolean;        -- True if instantiating component is periodic
  Universal : System.Address; -- address of general message callback
  Forward   : System.Address; -- address of any forward message table

package Disburse is

  type QueueDataType is private;

  Size : constant Integer := 10;

  type QueueDataArrayType is private;

  type QueueType is private;

  type QueuePtrType is access QueueType;
  for QueuePtrType'storage_size use 0;

  type DisburseTablePtrType
  is access Itf.DisburseTableType;
  for DisburseTablePtrType'storage_size use 0;

  procedure Clear;
  -- Clear the queue

  procedure EventWait;
  -- Wait for the provided wait event and then treat any queued messages

  procedure ProvideWaitEvent
  ( Event : in ExecItf.HANDLE );
  -- Specify wait event to be used to signal component
  -- Note: The Wait Event Handle would be provide with the instantiation
  --       parameters except that the queue has to be provided to the
  --       Register of the component and the handle isn't known until
  --       the Register procedure returns.

  function Read
  return Itf.MessageType;
  -- Return message from queue or null message if queue is empty

  function Unread
  return Boolean;
  -- Return whether there are unread messages in the queue

  function Write
  ( Message : in Itf.MessageType
  ) return Boolean;
  -- Write message to the queue and return if successful

private

  type QueueDataType
  is record
    Message : Itf.MessageType;
  end record;

  type QueueDataArrayType
  is array (1..Size) of QueueDataType;

  type QueueType
  is record
    Name           : Itf.V_Short_String_Type; -- Name given to the queue by the component
    WaitHandle     : ExecItf.HANDLE;
    Universal      : Itf.ForwardType;
    Unread         : Boolean;
    NextReadIndex  : Integer;
    NextWriteIndex : Integer;
    List : QueueDataArrayType;
  end record;

end Disburse;

Note: The use of private prevents only packages from referencing the private types.

with Text_IO;
with Unchecked_Conversion;

package body Disburse is

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

  ForwardPtr : DisburseTablePtrType;

  Queue : QueueType;

  procedure Clear is
  begin -- Clear
    Queue.Unread := False;
    Queue.NextReadIndex := 1;
    Queue.NextWriteIndex := 1;
  end Clear;

  -- This procedure is necessary since the instantiation of the queue has to be
  -- done before the wait event handle is known.
  procedure ProvideWaitEvent
  ( Event : in ExecItf.HANDLE
  ) is
  begin -- ProvideWaitEvent
    Queue.WaitHandle := Event;
  end ProvideWaitEvent;

  procedure ForwardMessage is

    ForwardRef : Itf.ForwardType;
    Message    : Itf.MessageType;

    use type Itf.ForwardType;
    use type Topic.Id_Type;
    use type Topic.TopicIdType;
    use type Topic.Extender_Type;

  begin -- ForwardMessage

    -- Continue as long as messages in the queue
    while Unread loop
      ForwardRef := null;
      -- Read message from queue
      Message := Read;
      if Message.Header.Id = Itf.NullMessage.Header.Id then
        exit; -- loop; no more messages
      end if;

      -- Lookup callback associated with message topic
      if ForwardPtr /= null then
        for I in 1..ForwardPtr.Count loop

          if Message.Header.Id.Topic = ForwardPtr.List(I).TopicId.Topic
          and then
             Message.Header.Id.Ext = ForwardPtr.List(I).TopicId.Ext
          then
            ForwardRef := ForwardPtr.List(I).Forward;
            Exit; -- for loop for topic
          end if;
        end loop; -- for
      end if;

      -- Invoke the callback passing the received message
      if ForwardRef /= null then
        ForwardRef( Message => Message );
      else -- Invoke the universal callback of the component for the message
        Queue.Universal( Message => Message );
      end if;
    end loop; -- while Unread messages

  end ForwardMessage;

  -- This procedure waits for the wait event associated with the queue which is
  -- the event associated with the component.  The event is that of the thread
  -- of the component and so switches from the thread that delivered the message
  -- to that of the component.
  -- Note: ProvideWaitEvent must be called to provide the particular wait event
  --       before the component goes into its wait forever loop.
  procedure EventWait is

    WaitResult  : ExecItf.WaitReturnType;
    ResetResult : Boolean;

  begin -- EventWait
    -- Wait for the event to be signaled
    WaitResult  := ExecItf.WaitForSingleObject(Queue.WaitHandle, -1);
    -- Reset the wait handle
    ResetResult := ExecItf.Reset_Event(Queue.WaitHandle);

    -- Forward the message(s) of the queue to a particular message callback if
    -- specified for the topic or to the universal message callback when not in
    -- a forward message table.
    ForwardMessage;

  end EventWait;

  function Read
  return Itf.MessageType is
    RtnNone : Boolean := False;
    SavedReadIndex : Integer;

  begin -- Read

    if Queue.NextReadIndex = Queue.NextWriteIndex then
      Text_IO.Put_Line("Disburse Read NRI == nWI");
      Queue.Unread := False;
      RtnNone := True;
      return Itf.NullMessage;
    end if;

    SavedReadIndex := Queue.NextReadIndex;
    if Queue.NextReadIndex >= Size then
      Queue.NextReadIndex := 1;
    else
      Queue.NextReadIndex := Queue.NextReadIndex + 1;
    end if;
    if Queue.NextReadIndex = Queue.NextWriteIndex then
      Queue.Unread := False;
    else
      Queue.Unread := True;
    end if;
    return Queue.List(SavedReadIndex).Message;

  end Read;

  function Unread
  return Boolean is
  begin -- Unread
    return Queue.Unread;
  end Unread;

  function Write
  ( Message : in Itf.MessageType
  ) return Boolean is

    Forwarded : Boolean := False;
    Rtn : Boolean := True;

    CurrentIndex : Integer := Queue.NextWriteIndex;
    NextIndex    : Integer := CurrentIndex + 1;

    Result : Boolean;

    use type System.Address;

    function to_int is new unchecked_conversion
      ( source => System.Address,
        target => Integer );

  begin -- Write

    -- Queue the message
    if NextIndex >= Size then
      NextIndex := 1;
    end if;
    if NextIndex = Queue.NextReadIndex then -- queue overrun
      Text_IO.Put("ERROR: Disburse ");
      Text_IO.Put(Queue.Name.Data(1..Queue.Name.Count));
      Text_IO.Put_Line(" overrun");
      Rtn := False;
    end if;

    if Rtn then
      Queue.List(CurrentIndex).Message := Message;
      Queue.NextWriteIndex := NextIndex;
      Queue.Unread := True;
    end if;

    -- End the wait if queue not associated with a periodic component.
    -- The end of the wait will result in the thread of the component
    -- associated with the queue getting control switching from the
    -- thread that delivered the message.
    -- Note: Additional messages might be enqueued while the message just
    --       queued is being treated since it might be delivered by a higher
    --       priority thread that suspends the receiving component.
    if Queue.WaitHandle /= System.Null_Address and then
       not Periodic
    then
      Result := ExecItf.Set_Event( Event => Queue.WaitHandle );
    elsif not Periodic then
      Text_IO.Put("ERROR: No queue wait handle to signal end of wait ");
      Text_IO.Put_Line(Queue.Name.Data(1..Queue.Name.Count));
    end if;

    return Rtn;

  end Write;

begin -- instantiation procedure
  declare
    ComponentQueueName : Itf.V_Short_String_Type;
    for ComponentQueueName use at QueueName;
    function to_Ptr1 is new Unchecked_Conversion
                            ( Source => System.Address,
                              Target => Itf.ForwardType );
    function to_Ptr2 is new Unchecked_Conversion
                            ( Source => System.Address,
                              Target => DisburseTablePtrType );
  begin
    Queue.Name.Count := ComponentQueueName.Count;
    Queue.Name.Data  := ComponentQueueName.Data;
    Queue.WaitHandle := System.Null_Address; -- until provided
    Queue.Universal  := to_Ptr1(Universal);
    Queue.Unread := False;
    Queue.NextReadIndex := 1;
    Queue.NextWriteIndex := 1;

    ForwardPtr := to_Ptr2(Forward);

  end;

end Disburse;

Component

The Component package differs from that of C# since the Receive and Transmit packages have yet to be translated to Ada.  Each of these two packages will need to be generic since a thread will be needed for each remote application.

The Component class/package is a central location in which the various components – user components and message delivery framework components such as Receive and Transmit have their characteristics retained in a component table.  Since the message delivery framework application is structured such that the components are registered with the Component class/package prior to the Threads class/package being invoked, a unique thread can be created for each of the components.

The Component class/package ensures that a unique identifier is created for each component.  This identifier, referred to as a key in the package, consists of an application identifier, a component identifier, and a subcomponent identifier.  Each application of the configuration will have its own application identifier by which the message delivery framework can determine the source of a message.  Likewise, each component of an application has its own component identifier that is assigned by Component.  As yet the subcomponent identifier is without a purpose.

The user component receive queue (that is, Disburse) is passed to Component Register.  For C# the wait event for the component is also passed whereas for Ada the Component Register assigns the event and returns it to the user component.  In either case the main callback entry point of the component is passed to Register to be saved in the component table.  This allows this information to be used by the Threads class/package.

Currently the component table and its structure is visible to other packages.  Only Threads should need some of this data so methods/functions should be added to return it with the structure and table hidden from other C# classes or Ada packages.

Component.cs

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading; // to store event wait handle

public delegate void MainEntry(); // callback entry
public delegate void Callback();  //  points
public delegate void Forward(VisualCompiler.Delivery.MessageType message);

namespace VisualCompiler
{
    static public class Component
    {
        //  Framework class that keeps track of registered components.

        public const int MaxUserComponents = 8;
        // Maximum allowed number of user (non-framework) components
        public const int MaxComponents =
                           8 + (2 * (Configuration.MaxApplications - 1));

        // Register result possibilities
        public enum ComponentStatus
        {
            NONE,
            VALID,
            DUPLICATE,
            INVALID,
            INCONSISTENT,
            INCOMPLETE
        };

        public enum ComponentKind
        {
            USER,
            FRAMEWORK,
            RECEIVE,   // special framework component
            TRANSMIT   // special framework component
        };

        public enum ComponentSpecial
        {
            NORMAL,
            RECEIVE,
            RECEIVEINTERFACE,
            TRANSMIT
        };

        // Identifier of application
        public struct ApplicationId
        {
            public string name; // application name
            public int id; // application numeric id
        }

        // Identifier of component
        public struct ParticipantKey
        {
            public int appId; // application identifier
            public int comId; // component identifier
            public int subId; // subcomponent identifier
        };

        static public ParticipantKey nullKey;

        // Determine if two components are the same
        static public bool CompareParticipants(ParticipantKey left,
                                               ParticipantKey right)
        {
            if ((left.appId == right.appId) &&
                (left.comId == right.comId) &&
                (left.subId == right.subId))
            {
                return true;
            }
            else
            {
                return false;
            }
        } // end CompareParticipants

        public struct RegisterResult
        {
            public ComponentStatus status;
            public ParticipantKey key;
        };

        // Component data from registration as well as run-time status
        public struct ComponentDataType
        {
            public ComponentKind kind;
            // Whether user component or a framework component
            public string name;
            // Component name
            public ParticipantKey key;
            // Component key (application and component identifiers)
            public int period;
            // Periodic interval in milliseconds; 0 if only message consumer
            public Threads.ComponentThreadPriority priority;
            // Requested priority for component
            public MainEntry fMain;
            // Main entry point of the component
            public Disburse queue;
            // Alternate message queue of the component
            public ComponentSpecial special;
            // Special processing
            public PeriodicTimer timer;
            // Thread timer of special components
            public EventWaitHandle waitHandle;
            // Wait Handle to use to signal end of wait
        };

        // List of components
        public class ComponentTableType
        {
            public bool allowComponentRegistration;
            // True indicates that components are allowed to register themselves
            public int count;
            // Number of registered components of the application
            public ComponentDataType[] list = new ComponentDataType[MaxComponents];
            // Registration supplied data concerning the component as well as
            // run-time status data
        };

        // 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 ComPeriodic.
        // Note: There must be one creation of a new table.  Only one instance.
        static public ComponentTableType componentTable = new ComponentTableType();

        // true if Component class has been initialized
        static public bool componentInitialized = false;

        // Find the index into the registered Application table of the currently
        // running application and return it.
        static private int ApplicationIndex()
        {
            int index; // Index of hosted function application in Application table

            // Find index to be used for hosted function application processor
            index = App.applicationId;
            if (index == 0)
            {
                Console.WriteLine("ERROR: Application Index doesn't exist");
            }
            return index;

        } // end ApplicationIndex;   

        static public Disburse GetQueue(ParticipantKey component)
        {
            for (int i = 0; i < componentTable.count; i++)
            {
                if (CompareParticipants(componentTable.list[i].key, component))
                {
                    return componentTable.list[i].queue;
                }
            }
            return null;
        } // end GetDisburseQueue

        // Initialize the component table.  Substitute for constructor.
        static public void Initialize()
        {
            nullKey.appId = 0;
            nullKey.comId = 0;
            nullKey.subId = 0;

            componentTable.count = 0;
            componentTable.allowComponentRegistration = false;
        }

        // 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.
        static private int Lookup(string name)
        {
            int app; // Application id
            int idx; // Index of component in registry

            app = ApplicationIndex();

            idx = 0;
            for (int i = 0; i < componentTable.count - 1; i++)
            {
                if (String.Compare(name, componentTable.list[i].name, false) == 0)
                {
                    idx = i;
                    break; // exit loop
                }
            } // 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.
        static private ParticipantKey NextComponentKey()
        {
            int app; // Index of current application

            app = ApplicationIndex();

            ParticipantKey returnApp;
            if (componentTable.count < MaxComponents)
            {
                componentTable.count = componentTable.count + 1;
                returnApp.appId = app;
                returnApp.comId = componentTable.count;
                returnApp.subId = 0;
                return returnApp;
            }
            else
            {
                Console.WriteLine("ERROR: More components than can be accommodated");
                return nullKey;
            }

        } // end NextComponentKey

        // Register a periodic callback component.
        static public RegisterResult Register
                      (string name,         // name of component
                       int period,  // # of millisec at which Main() function to cycle
                       Threads.ComponentThreadPriority priority, // Requested priority of thread
                       MainEntry callback,  // Callback() function of component
                       Disburse queue)      // message queue of component
        {
            int app;      // Index of current application
            int cIndex;   // Index of component; 0 if not found
            int location; // Location of component in the registration table
            ParticipantKey newKey; // Component key of new component
            newKey = nullKey;

            RegisterResult result;
            result.status = ComponentStatus.NONE; // unresolved
            result.key = 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) // duplicate registration
            {
                result.status = ComponentStatus.DUPLICATE;
                return result;
            }

            // Add new component to component registration table.
            //
            //   First obtain the new table location and set the initial values.
            newKey = NextComponentKey();

            location = componentTable.count - 1;

            componentTable.list[location].kind = ComponentKind.USER;
            componentTable.list[location].name = name;
            componentTable.list[location].key = newKey;
            componentTable.list[location].period = period;
            componentTable.list[location].priority = priority;
            componentTable.list[location].fMain = (MainEntry)callback;
            componentTable.list[location].queue = queue;
            componentTable.list[location].special = ComponentSpecial.NORMAL;
            componentTable.list[location].timer = null;
            if (period > 0)
            { // end of wait is signaled by Timer of Threads.cs
                componentTable.list[location].waitHandle = queue.QueueWaitHandle();
            }
            else
            { // end of wait is signaled by Write of new message
                componentTable.list[location].waitHandle = null;
            }

            // Return status and the assigned component key.
            result.status = ComponentStatus.VALID;
            result.key = newKey;
            return result;
        } // end Register
       
        // Register a callback component.
        static public RegisterResult Register
                      (string name,         // name of component
                       Threads.ComponentThreadPriority priority, // Requested priority of thread
                       MainEntry callback,  // Callback() function of component
                       Disburse queue)      // message queue of component
        {
            return Register(name, 0, priority, callback, queue);
        } // end Register

        // Register a component.
        static public RegisterResult Register
                      (string name, // name of component
                       int period,  // # of millisec at which Main() function to cycle
                       Threads.ComponentThreadPriority priority, // Requested priority of thread
                       MainEntry fMain,      // Main() function of component
                       Disburse queue,       // message queue of component
                       EventWaitHandle waitHandle) // wait handle for wakeup signal
        {
            int app;      // Index of current application
            int cIndex;   // Index of component; 0 if not found
            int location; // Location of component in the registration table
            ParticipantKey newKey; // Component key of new component
            newKey = nullKey;

            RegisterResult result;
            result.status = ComponentStatus.NONE; // unresolved
            result.key = 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) // duplicate registration
            {
                result.status = ComponentStatus.DUPLICATE;
                return result;
            }

            // Return if component is periodic but without a Main() entry point.
            if (period > 0)
            {
                if (fMain == null)
                {
                    result.status = ComponentStatus.INVALID;
                    return result;
                }
            }

            // Add new component to component registration table.
            //
            //   First obtain the new table location and set the initial values.
            newKey = NextComponentKey();

            location = componentTable.count - 1;

            componentTable.list[location].kind = ComponentKind.USER;
            componentTable.list[location].name = name;
            componentTable.list[location].key = newKey;
            componentTable.list[location].period = period;
            componentTable.list[location].priority = priority;
            componentTable.list[location].fMain = fMain;
            componentTable.list[location].queue = queue;
            componentTable.list[location].special = ComponentSpecial.NORMAL;
            componentTable.list[location].timer = null;
            componentTable.list[location].waitHandle = waitHandle;

            // Return status and the assigned component key.
            result.status = ComponentStatus.VALID;
            result.key = newKey;
            return result;
        } // end Register

        static public RegisterResult RegisterRemote(string name, int remoteAppId,
                                                    MainEntry fMain)
        {
            int app;      // Index of current application
            int location; // Location of component in the registration table
            ParticipantKey newKey; // Component key of new component
            newKey = nullKey;

            RegisterResult result;
            result.status = ComponentStatus.NONE; // unresolved
            result.key = nullKey;

            // Find index to be used for application
            app = ApplicationIndex();

            // Since a framework component register, assuming not a duplicate.
            // Add new component to component registration table.
            //
            //   First obtain the new table location and set the initial values.
            newKey = NextComponentKey();

            location = componentTable.count - 1;

            componentTable.list[location].kind = ComponentKind.FRAMEWORK;
            componentTable.list[location].name = name + remoteAppId;
            componentTable.list[location].key = newKey;
            componentTable.list[location].period = 0; // to avoid a Timer
            componentTable.list[location].priority =
              Threads.ComponentThreadPriority.HIGH;
            componentTable.list[location].fMain = fMain;
            componentTable.list[location].queue = null; // uses circular queue instead
            componentTable.list[location].special = ComponentSpecial.RECEIVEINTERFACE;
            componentTable.list[location].timer = null;
            componentTable.list[location].waitHandle = null; // waitHandle supplied differently

            // Return status and the assigned component key.
            result.status = ComponentStatus.VALID;
            result.key = newKey;
            return result;
        } // end RegisterRemote

        static public RegisterResult RegisterReceive(string name)
        {
            int app;      // Index of current application
            int location; // Location of component in the registration table
            ParticipantKey newKey; // Component key of new component
            newKey = nullKey;

            RegisterResult result;
            result.status = ComponentStatus.NONE; // unresolved
            result.key = nullKey;

            // Find index to be used for application
            app = ApplicationIndex();

            // Since a framework register, assuming not a duplicate.
            // Add new component to component registration table.
            //
            //   First obtain the new table location and set the initial values.
            newKey = NextComponentKey();

            location = componentTable.count - 1;

            componentTable.list[location].kind = ComponentKind.RECEIVE;
            componentTable.list[location].name = name; // "R" + name;
            componentTable.list[location].key = newKey;
            componentTable.list[location].period = 0;
            componentTable.list[location].priority =
              Threads.ComponentThreadPriority.HIGH;
            componentTable.list[location].fMain = null;
            componentTable.list[location].queue = null;
            componentTable.list[location].special = ComponentSpecial.RECEIVE;
            componentTable.list[location].timer = null;
            componentTable.list[location].waitHandle = null;

            // Return status and the assigned component key.
            result.status = ComponentStatus.VALID;
            result.key = newKey;
            return result;
        } // end RegisterReceive

        static public RegisterResult RegisterTransmit(int name, Transmit transmit)
        {
            int app;      // Index of current application
            int location; // Location of component in the registration table
            ParticipantKey newKey; // Component key of new component
            newKey = nullKey;

            RegisterResult result;
            result.status = ComponentStatus.NONE; // unresolved
            result.key = nullKey;

            // Find index to be used for application
            app = ApplicationIndex();

            // Since a framework register, assuming not a duplicate.

            // Add new component to component registration table.
            //
            //   First obtain the new table location and set the initial values.
            newKey = NextComponentKey();

            location = componentTable.count - 1;

            componentTable.list[location].kind = ComponentKind.TRANSMIT;
            componentTable.list[location].name = "T" + name;
            componentTable.list[location].key = newKey;
            componentTable.list[location].period = 0; // not periodic
            componentTable.list[location].priority =
              Threads.ComponentThreadPriority.HIGH;
            componentTable.list[location].fMain = transmit.Callback;
            componentTable.list[location].queue = transmit.queue;
            componentTable.list[location].queue = null;
            componentTable.list[location].special = ComponentSpecial.TRANSMIT;
            componentTable.list[location].timer = null;
            componentTable.list[location].waitHandle = null;

            // Return status and the assigned component key.
            result.status = ComponentStatus.VALID;
            result.key = newKey;
            return result;
        } // end RegisterTransmit

    } // end Component class
} // end namespace

Itf Ada package

Because Ada can get into circular package references many general type declarations have been assigned to an Itf package that, except for one procedure, only consists of a specification.  This package is provided in its current condition for reference.

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 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; --Integer;   -- 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;

  -- 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; --<<< use Character ?? >>>
  for GenericMessageType'alignment use Message_Alignment; --4; -- bytes


end Itf;

package body Itf is

  procedure Initialize is
 
  begin -- Initialize
 
    NullMessage.Header.CRC := 0;
    NullMessage.Header.Id.Topic := Topic.NONE;
    NullMessage.Header.Id.Ext := Topic.FRAMEWORK;
    NullMessage.Header.From.AppId := 0;
    NullMessage.Header.From.ComId := 0;
    NullMessage.Header.From.SubId := 0;
    NullMessage.Header.To.AppId := 0;
    NullMessage.Header.To.ComId := 0;
    NullMessage.Header.To.SubId := 0;
    NullMessage.Header.ReferenceNumber := 0;
    NullMessage.Header.Size := 0;
    NullMessage.Data(1) := ASCII.NUL;
 
  end Initialize;

end Itf;

Component Ada package

The version of Component presented below is unchanged from that used for the previous post.  

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;

  -- 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)
    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;
    -- Alternate message queue of the component
    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: 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;

  procedure Initialize;

  function Register
  ( Name     : Itf.V_Medium_String_Type; -- name of component
    Period   : Integer;   -- # of millisec at which Main() function to cycle
    Priority : Threads.ComponentThreadPriority; -- Requested priority of thread
    Callback : Topic.CallbackType; -- Callback() function of component
    Queue    : System.Address      -- message queue of component
  ) return RegisterResult;

end Component;


with CStrings;
with System;
with Text_IO;
with Unchecked_Conversion;

package body Component is

  -- 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;

  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     : Itf.V_Medium_String_Type; -- name of component
    Period   : Integer;      -- # of millisec at which Main() function to cycle
    Priority : Threads.ComponentThreadPriority; -- Requested priority of thread
    Callback : Topic.CallbackType; -- Callback() function of component
    Queue    : System.Address      –- message queue 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;

    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 := USER;
    ComponentTable.List(Location).Name := Name;

    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).Period := Period;
    ComponentTable.List(Location).Priority := Priority;
    ComponentTable.List(Location).fMain := Callback;
    ComponentTable.List(Location).WaitEvent := Result.Event;
    ComponentTable.List(Location).Queue := Queue;

    -- Return status and the assigned component key.
    Result.Status := VALID;
    Result.Key := NewKey;
    return Result;

  end Register;

end Component;

Configuration

The Configuration package is used to determine which applications are to be involved in the remote delivery of messages.  It is contained in a file named Apps-Configuration.dat that is located in the path of the running application.  The Configuration package code searches back from the directory/folder of the application executable until it locates the file and then reads and parses it to determine the applications of the configuration.

The following is a sample of the Apps-Configuration.dat file.  The second line is too long to be displayed so Word has broke the line at the - following the PC name and also on a third line.  Currently the second and third fields of the first line aren't used since the applications can be both C# and Ada based.  Also only the first two fields of the application lines are currently used providing the numeric and alpha identifiers of the application.  The third field identifies the communication method to be used between applications and is unused since the current message delivery framework only uses pipes for the communication between applications – TCP/IP sockets being, for instance, another option that is not currently supported for which the PC name field would come into use.  The final field (fields are separated by the | character) is the path to the application's executable.  This has been used in the past to automatically load all the applications of the configuration.

2|C#|Topic|
1|App 1|MSPipe|COSTCO-HP|C:\Source\XP3\Try3\VisualCompiler\WindowsFormsApplication1\WindowsFormsApplication1\bin\Release\WindowsFormsApplication1.exe|
2|App 2|MSPipe|COSTCO-HP|C:\Source]XP3\Try3\OFPApp\Build\Main.exe|

Each Configuration implementation starts with the location of the running application and works backwards to locate the Apps-Configuration.dat file.  It then parses it to create the Configuration Table.

Configuration.cs

using System;
using System.Collections.Generic;
using System.IO;
using System.Linq;
using System.Text;

namespace VisualCompiler
{
    static public class Configuration
    {
        // Maintain the configuration of applications

        public const int MaxApplications = 4;
        // Maximum allowed number of allowed applications

        // Possible methods of inter-application communications
        //--> move to Remote class
        public enum CommMethod
        {
            NONE,    // Topic added to the library
            MS_PIPE, // Topic already added for the component
            TCP_IP   // Topic not added
        };


        // Note: The executable can be in either the Debug or Release folders.
        public struct ConfigurationDataType
        {
            public Component.ApplicationId app; // name and id
            public CommMethod commMethod; // communication method
            public string computerId; // expected computer identifier
            public string appPath; // path to application executable

            public bool connected; // true if connected to the remote app
        };

        public class ConfigurationTableType
        {
            public int count; // Number of declared applications
            public ConfigurationDataType[] list = new
                     ConfigurationDataType[MaxApplications];
            // will need to be expanded
        };

        static public ConfigurationTableType configurationTable = new
                        ConfigurationTableType();

        public struct ParseParameters
        {
            public char delimiter; // = '|';
            public int decodePhase; // = 0;
            public int appCount; // = 0;
            public int field; // = 0;
            public string temp; // = "";
        };

        static public void Initialize()
        {
            // Obtain the path of the configuration file.
            string configurationFile = FindConfigurationFile();
            if (configurationFile.Length < 22)
            {
                Console.WriteLine("ERROR: No Apps-Configuration.dat file found");
                return;
            }

            // Open and parse the configuration file.
            using (FileStream fs = File.Open(configurationFile, FileMode.Open,
                                             FileAccess.Read, FileShare.None))
            {
                byte[] fileData = new byte[1024];
                UTF8Encoding temp = new UTF8Encoding(true);

                while (fs.Read(fileData, 0, fileData.Length) > 0)
                {
                    Console.WriteLine(temp.GetString(fileData));
                }

                Parse(fileData);

                for (int i = 0; i < configurationTable.count; i++)
                {
                    configurationTable.list[i].connected = false;
                }
            }

        }  // end Initialize
       
        // Locate the configuration data file in the path of application execution.
        static private string FindConfigurationFile()
        {
            string nullFile = "";

            // Get the current directory/folder.
            string path = Directory.GetCurrentDirectory();

            // Find the Apps-Configuration.dat file in the path.
            bool notFound = true;
            while (notFound)
            {
                // Look for the file in this directory
                string newPath;
                char backSlash = '\\';
                int index = path.Length - 1;
                for (int i = 0; i < path.Length; i++)
                {
                    int equal = path[index].CompareTo(backSlash);
                    if (equal == 0)
                    {
                        newPath = path.Substring(0, index); // the portion of path
                                                      // that ends just before '\'
                        string[] dirs = Directory.GetFiles(newPath, "*.dat");
                        string file = "Apps-Configuration.dat";
                        int fileLength = file.Length;
                        foreach (string dir in dirs)
                        {
                            string datFile = dir.Substring(index+1, fileLength);
                            equal = datFile.CompareTo(file);
                            if (equal == 0)
                            {
                                return dir;
                            }
                        }
                        path = newPath; // reduce path to look again
                        if (path.Length < 10)
                        { return nullFile; }
                   }
                   index--;

                    // what if newPath has become C: or such with no file found
                }
            } // end while loop

            // Read and decode the configuration file into the table

            return nullFile;

        } // end FindConfigurationFile

        static private ParseParameters p;

        static private void Parse(byte[] data)
        {
            p.delimiter = '|';
            p.decodePhase = 0;
            p.appCount = 0;
            p.field = 0;
            p.temp = "";
            for (int i = 0; i < data.Length; i++)
            {
                if (p.decodePhase == 0)
                {  // decode header
                    ParseHeader(data, i);
                } // end headerPhase
                else
                { // decode application data
                    ParseData(data, i);
                    if (p.appCount == configurationTable.count)
                    {
                        return; // done with Parse
                    }
                } // end application data parse

            } // end for loop

            Console.WriteLine("ERROR: Invalid Apps-Configuration.dat file");

        } // end Parse

        static private void ParseHeader(byte[] data, int i)
        {
                 // Check for end-of-line first
            if (p.field == 3)
            { // bypass end of line characters
                if ((data[i] == '\r') || (data[i] == '\n'))
                {
                }
                else
                {
                    p.temp += (char)data[i]; // retain char for next phase
                    p.field = 0;
                    p.decodePhase++; // end first phase
                }
            }
            else // parse within the line
            { // Get Count, Language, and Framework
                if (data[i] != p.delimiter)
                {
                    p.temp += (char)data[i];
                }
                else
                { // treat field prior to delimiter
                    if (p.field == 0)
                    {
                        try
                        {
                            configurationTable.count = Convert.ToInt32(p.temp);
                        }
                        catch (OverflowException)
                        {
                            Console.WriteLine("ERROR: {0} is outside the range of the Int32 type.", p.temp);
                        }
                        catch (FormatException)
                        {
                            Console.WriteLine("ERROR: The {0} value '{1}' is not in a recognizable format.",
                                              p.temp.GetType().Name, p.temp);
                        }
                        p.temp = ""; // initialize for next field
                        p.field++;
                    }
                    else if (p.field == 1)
                    {
                        p.temp = ""; // initialize for next field
                        p.field++;
                    }
                    else if (p.field == 2)
                    {
                        p.temp = ""; // initialize for next field
                        p.field++;
                    }

                } // end treat field prior to delimiter
            }

        } // end ParseHeader


        static private void ParseData(byte[] data, int i)
        {
            if (p.field == 5)
            { // bypass end of line characters
                if ((data[i] == '\r') || (data[i] == '\n'))
                {
                }
                else
                {
                    p.temp += (char)data[i]; // retain char for next phase
                    p.field = 0;  // start over for next application
                }
            }
            else // not end-of-line
            { // Get application id and name, etc
                if (data[i] != p.delimiter)
                {
                    p.temp += (char)data[i];
                }
                else
                { // treat field prior to delimiter
                    if (p.field == 0)
                    { // decode application id
                        try
                        {
                            configurationTable.list[p.appCount].app.id =
                              Convert.ToInt32(p.temp);
                        }
                        catch (OverflowException)
                        {
                            Console.WriteLine("ERROR: {0} is outside the range of the Int32 type.", p.temp);
                        }
                        catch (FormatException)
                        {
                            Console.WriteLine("ERROR: The {0} value '{1}' is not in a recognizable format.",
                                              p.temp.GetType().Name, p.temp);
                        }

                        p.temp = ""; // initialize for next field
                        p.field++;
                    }
                    else if (p.field == 1)
                    { // decode application name
                        configurationTable.list[p.appCount].app.name = p.temp;

                        p.temp = ""; // initialize for next field
                        p.field++;
                    }
                    else if (p.field == 2)
                    { // decode communication method
                        if (String.Compare("MSPipe", p.temp, true) == 0)
                        {
                            configurationTable.list[p.appCount].commMethod =
                              CommMethod.MS_PIPE;
                        }
                        else if (String.Compare("TCPIP", p.temp, true) == 0)
                        {
                            configurationTable.list[p.appCount].commMethod =
                              CommMethod.TCP_IP;
                        }
                        else
                        {
                            configurationTable.list[p.appCount].commMethod =
                              CommMethod.NONE;
                        }

                        p.temp = ""; // initialize for next field
                        p.field++;
                    }
                    else if (p.field == 3)
                    { // decode required computer name
                        configurationTable.list[p.appCount].computerId = p.temp;

                        p.temp = ""; // initialize for next field
                        p.field++;
                    }
                    else if (p.field == 4)
                    { // decode path of executable
                        configurationTable.list[p.appCount].appPath = p.temp;

                        p.temp = ""; // initialize for next field
                        p.field++;

                        p.appCount++; // increment index for list
                        if (p.appCount == configurationTable.count)
                        {
                            return; // done with Parse
                        }
                    }
                } // end treat field prior to delimiter
            } // end else
       } // end ParseData

    } // end Configuration

} // end namespace

Configuration Ada package

with Itf;

package Configuration is

  MaxApplications
  -- Maximum allowed number of allowed applications
  : constant Integer := 4;


  type Computer_Name_Length_Type
  -- Range of characters allowed for a computer name
  is range 0..20;

  type Computer_Name_Type
  -- Name of the computer running the application for the connection
  is record
    Length : Computer_Name_Length_Type;
    -- Number of characters in the name
    Name   : String(1..Integer(Computer_Name_Length_Type'last));
    -- NetBIOS name of the computer
  end record;

  type ConfigurationDataType
  is record
    App        : Itf.ApplicationIdType;  -- name and id
    CommMethod : Itf.CommMethodType;     -- communication method
    ComputerId : Computer_Name_Type;     -- expected computer identifier
    AppPath    : Itf.V_Long_String_Type; -- path to application executable
    Connected  : Boolean;                -- true if connected to the remote app
  end record;

  type ConfigurationDataArrayType
  is array (0..MaxApplications-1) of ConfigurationDataType;

  type ConfigurationTableType
  is record
    Count : Integer; -- Number of declared applications
    List  : ConfigurationDataArrayType;
  end record;

  ConfigurationTable
  --| Information about the hosted function applications of the configuration
  --| Notes:
  --|   The values in the table will be overridden by those of the
  --|   Apps-Configuration.dat file.  These are only SAMPLES.
  : ConfigurationTableType
  := ( Count => 1,
       List  => ( 1 => ( App        => ( Name => "App 1     ",
                                         Id   => 1 ),
                         CommMethod => Itf.NONE,
                         ComputerId => ( Length => 0,
                                         Name   => ( others => ' ' ) ),
                         AppPath    => ( Count => 0,
                                         Data  => ( others => ' ' ) ),
                         Connected  => False ),

                  others => ( App        => ( Name => ( others => ' ' ),
                                              Id   => 0 ),
                              CommMethod => Itf.NONE,
                              ComputerId => ( Length => 0,
                                              Name   => ( others => ' ' ) ),
                              AppPath    => ( Count => 0,
                                              Data  => ( others => ' ' ) ),
                              Connected  => False ) )
     );

  procedure Initialize;


end Configuration;


with CStrings;
with Directory;
with ExecItf;
with GNAT.IO;
with Itf;
with Remote;
with Text_IO;

package body Configuration is

  Bytes_Read
  -- Number of bytes of configuration data read
  : Integer;

  -- for Parse
  CR1         : Itf.Byte := 16#0D#; -- '\r'
  CR          : Character;
  for CR use at CR1'Address;
  NL1         : Itf.Byte := 16#0A#; -- '\n'
  NL          : Character;
  for NL use at NL1'Address;
  Delimiter   : Character := '|';
  DecodePhase : Integer := 0;
  AppCount    : Integer := 0;
  Field       : Integer := 0;
  Index       : Integer := 0;
  Temp        : String(1..140); -- enough for a long path

  Max_File_Size
  : constant Integer := 1000;

  subtype FileDataType is String(1..Max_File_Size);

  type File_Type
  -- Configuration name and handle
  is record
    Name   : ExecItf.Config_File_Name_Type;
    -- Name of configuration data file for applications
    Handle : ExecItf.File_Handle;
    -- Handle of configuration data file after created
  end record;

  Config_File
  -- Name and Handle of Apps-Configuration.dat file
  : File_Type;

  function FindConfigurationFile
  return File_Type;

  procedure Parse
  ( FileData : FileDataType
  );

  procedure Initialize is

    Configuration_Error
    -- True if an error in the Configuration file has been detected
    : Boolean := False;

    Data
    -- Data from config file
    : FileDataType;

    Result
    -- Create result
    : Integer;

    Success
    -- ReadFile return
    : Boolean;

    use type ExecItf.File_Handle;

  begin -- Initialize

    -- Obtain the path of the configuration file and open it.
    Config_File := FindConfigurationFile;

    -- Return if Configuration File not opened
    if Config_File.Handle = ExecItf.Invalid_File_Handle then
      return;
    end if;

    -- Read the configuration file.
    Bytes_Read := ExecItf.Read_File
                  ( File => Config_File.Handle, -- handle of disk file
                    Addr => Data'address,       -- buffer to receive data
                    Num  => Max_File_Size );    -- size of the buffer
    if Bytes_Read <= 0 then
      Result := Integer(ExecItf.GetLastError);
      Configuration_Error := True;
      return;
    end if;

    -- Close the file
    Success := ExecItf.Close_File( Handle => Config_File.Handle );

    -- Parse the configuration file data.
    Parse(Data);

    -- Set not yet connected. << does this go to Remote ? >>
    for I in 1..ConfigurationTable.Count loop
      ConfigurationTable.List(I).Connected := False;
    end loop;

  end Initialize;

  function FindConfigurationFile
  return File_Type is
  -- Notes: If running via GPS the folder that contains the gpr file seems to be
  --        the current directory.  If running from a DOS window of the Build
  --        folder, that is the current directory.  If run the exe file while
  --        in the folder of .dat file, that's the current directory.

    ConfigurationFile
    : Itf.V_Long_String_Type;

    Last
    : String(1..5);

    Path
    : Itf.V_Long_String_Type;

    Result
    -- Create result
    : Integer;

    use type ExecItf.File_Handle;

  begin -- FindConfigurationFile

    -- Get the current directory/folder.
    Path := Directory.GetCurrentDirectory;

    -- Attempt to open "Apps-Configuration.dat" file containing the current
    -- configuration of applications.
    ConfigurationFile.Data(1..Path.Count) := Path.Data(1..Path.Count);
    ConfigurationFile.Data(Path.Count+1..Path.Count+22) :=
      "Apps-Configuration.dat";
    ConfigurationFile.Count := Path.Count+22;

    Config_File := ( Name   => ( others => ASCII.NUL ),
                     Handle => ExecItf.Invalid_File_Handle );
    Config_File.Name(1..ConfigurationFile.Count) :=
      ConfigurationFile.Data(1..ConfigurationFile.Count);

    Config_File.Handle := ExecItf.Open_Read( Name => Config_File.Name );

    if Config_File.Handle = ExecItf.Invalid_File_Handle then
      Result := Integer(ExecItf.GetLastError);
      Text_IO.Put("Apps Configuration file doesn't exist");
      Int_IO.Put(Integer(Result));
      Text_IO.Put_Line(" ");

      -- Not in current directory.  Try previous directories.
      WhileLoop:
      while Config_File.Handle = ExecItf.Invalid_File_Handle loop
        for I in reverse 1..Path.Count-1 loop
          -- Find the previous backslash.
          if Path.Data(I) = '\' then
            ConfigurationFile.Data(1..I) := Path.Data(1..I);
            ConfigurationFile.Data(I+1..I+22) :=
              "Apps-Configuration.dat";
            ConfigurationFile.Count := I+22;
            Path.Count := I; -- where '\' was found
            Text_IO.Put("next path that will be searched ");
            Text_IO.Put_Line(Path.Data(1..Path.Count));

            Config_File := ( Name   => ( others => ASCII.NUL ),
                             Handle => ExecItf.Invalid_File_Handle );
            Config_File.Name(1..ConfigurationFile.Count) :=
              ConfigurationFile.Data(1..ConfigurationFile.Count);

            Config_File.Handle := ExecItf.Open_Read( Name => Config_File.Name );
            if Config_File.Handle = ExecItf.Invalid_File_Handle then
              if I < 5 then
                exit WhileLoop; -- not going to be found in the path
              end if;
            else
              exit WhileLoop;
            end if;
          end if;
        end loop;
      end loop WhileLoop;

      if Config_File.Handle = ExecItf.Invalid_File_Handle then
        -- Not in previous directories.  Prompt for the Path.
        Text_IO.Put("Enter the path to the Apps-Configuration.dat file: ");
        GNAT.IO.Get_Line( ConfigurationFile.Data, ConfigurationFile.Count );
        -- Check whether the .dat file was included
        Last(1..4) := ConfigurationFile.Data
                      (ConfigurationFile.Count-3..ConfigurationFile.Count);
        Last(5) := ASCII.NUL;
        declare
          Dat : String(1..5) := ".dat ";
        begin
          Dat(5) := ASCII.NUL;
          if (CStrings.Compare(Last'Address,Dat'Address,true) = 0) then
            -- Check whether the trailing \ was entered
            if ConfigurationFile.Data(ConfigurationFile.Count) /= '\' then
              ConfigurationFile.Count := ConfigurationFile.Count + 1;
              ConfigurationFile.Data(ConfigurationFile.Count) := '\';
            end if;
            -- Append the file name
            ConfigurationFile.Data(ConfigurationFile.Count+1..
                                   ConfigurationFile.Count+22) :=
              "Apps-Configuration.dat";
            Config_File.Name := ( others => ASCII.NUL );
            Config_File.Name(1..ConfigurationFile.Count+22) :=
              ConfigurationFile.Data(1..ConfigurationFile.Count+22);
            Text_IO.Put("New path ");
            Text_IO.Put_Line(ConfigurationFile.Data(1..ConfigurationFile.Count+22));
            -- Attempt to open the file
            Config_File.Handle := ExecItf.Open_Read( Name => Config_File.Name );
            if Config_File.Handle = ExecItf.Invalid_File_Handle then
              Result := Integer(ExecItf.GetLastError);
              Text_IO.Put("Entered Configuration file of ");
              Text_IO.Put(Config_File.Name(1..ConfigurationFile.Count));
              Text_IO.Put_Line(" doesn't exist");
            end if;
          end if;
        end;
      end if;

    end if;

    return Config_File;

  end FindConfigurationFile;

  procedure ParseData
  ( FileData : in FileDataType;
    I        : in Integer
  ) is

  begin -- ParseData

    if Field = 5 then
      -- bypass end of line characters
      if FileData(I) = CR or else FileData(I) = NL then
        null;
      else
        Index := Index + 1;
        Temp(Index) := FileData(I); -- retain character for next phase
        Field := 0; -- start over for next application
       end if;
    else -- parse within the line
      -- Get Application Id and Name, etc
      if FileData(I) /= Delimiter then
        Index := Index + 1;
        Temp(Index) := FileData(I); -- retain byte
      else -- treat field prior to delimiter
        if Field = 0 then -- decode application id
          declare
            AppId : Integer;
            Id : String(1..Index);
            for Id use at Temp'Address;
            Success : Boolean;
          begin
            CStrings.TryParse(Id'Address,Index,AppId,Success);
            if Success and then AppId > 0 and then AppId <= 9
            then
              ConfigurationTable.List(AppCount).App.Id := Itf.Int8(AppId);
            else
              Text_IO.Put_Line("Application Id not between 1 and 9");
            end if;
          end;
          Index := 0; -- initialize for next field
          Field := Field + 1;
          return;
        else
          if Field = 1 then -- decode application name
            declare
              Name : String(1..Index);
              for Name use at Temp'Address;
            begin
              ConfigurationTable.List(AppCount).App.Name := (others => ' ');
              ConfigurationTable.List(AppCount).App.Name(1..Index) := Name;
            end;
            Index := 0; -- initialize for next field
            Field := Field + 1;
            return;
          end if;
          if Field = 2 then -- decode communication method
            declare
              Method : String(1..Index);
              for Method use at Temp'Address;
            begin
              if Method = "MSPipe" then
                ConfigurationTable.List(AppCount).CommMethod := Itf.MS_PIPE;
              else
                if Method = "TCPIP" then
                  ConfigurationTable.List(AppCount).CommMethod := Itf.TCP_IP;
                else
                  ConfigurationTable.List(AppCount).CommMethod := Itf.NONE;
                end if;
              end if;
              Index := 0; -- initialize for next field
              Field := Field + 1;
              return;
            end;
          end if;
          if Field = 3 then -- decode required computer name
            declare
              Name : String(1..Index);
              for Name use at Temp'Address;
            begin
              ConfigurationTable.List(AppCount).ComputerId.Length :=
                Computer_Name_Length_Type(Index);
              ConfigurationTable.List(AppCount).ComputerId.Name := (others=>' ');
              ConfigurationTable.List(AppCount).ComputerId.Name(1..Index) := Name;
              Index := 0; -- initialize for next field
              Field := Field + 1;
            end;
            return;
          end if;
          if Field = 4 then -- decode path of executable
            declare
              Path : String(1..Index);
              for Path use at Temp'Address;
            begin
              ConfigurationTable.List(AppCount).AppPath.Count := Index;
              ConfigurationTable.List(AppCount).AppPath.Data := (others => ' ');
              ConfigurationTable.List(AppCount).AppPath.Data(1..Index) := Path;
              Index := 0; -- initialize for next field
              Field := Field + 1;
            end;
            AppCount := AppCount + 1; -- increment index for list
            if AppCount = ConfigurationTable.Count then
              return; -- done with Parse
            end if;
          end if;
        end if;
      end if;
    end if;
  end ParseData;

  procedure ParseHeader
  ( FileData : in FileDataType;
    I        : in Integer
  ) is

  begin -- ParseHeader

    if Field = 3 then
      -- bypass end of line characters
      if FileData(I) = CR or else FileData(I) = NL then
        null;
      else
        Index := Index + 1;
        Temp(Index) := FileData(I); -- retain byte for next phase
        Field := 0;
        DecodePhase := DecodePhase + 1; -- end of first phase
      end if;
    else -- parse within the line
      -- Get Count, Language, and Framework
      if FileData(I) /= Delimiter then
        Index := Index + 1;
        Temp(Index) := FileData(I);
      else -- treat field prior to delimiter
        if Field = 0 then
          declare
            Result : Integer := 0;
            Success : Boolean;
            Count : String(1..Index);
            for Count use at Temp'Address;
          begin
            CStrings.TryParse(Count'Address,Index,Result,Success);
            ConfigurationTable.Count := Result;
          end;

          Index := 0; -- initialize for next field
          Field := Field + 1;
        elsif Field = 1 then -- initialize for next field
          Index := 0; -- initialize for next field
          Field := Field + 1;
        elsif Field = 2 then -- initialize for next field
          Index := 0; -- initialize for next field
          Field := Field + 1;
        end if;
      end if;
    end if;

  end ParseHeader;

  procedure Parse
  ( FileData : in FileDataType
  ) is

  begin -- Parse

    for I in 1..Bytes_Read loop
      if DecodePhase = 0 then
        ParseHeader(FileData, I);
      else
        ParseData(FileData, I);
        if AppCount = ConfigurationTable.Count then
          return; -- done with Parse
        end if;
      end if;
    end loop;

    Text_IO.Put_Line("ERROR: Invalid Apps-Configuration.dat file");

  end Parse;

end Configuration;


Test/Debug

To debug the Disburse queue package I created 2 more dummy components from the previous post that had the debug of the Threads and PeriodicTimer packages (along with the Component package).  This meant that Threads had to implement more component threads so I extended it to have the capability of having 14 such threads to match the C# implementation.  Note: Only as many threads as have been registered to Component are actually created.

Dummy components are declared in the Test package since the ability to install components has yet to be translated from the C# message delivery framework.

For example in a Test package,
  procedure Test6 is
  begin -- Test6

    Itf.ApplicationId.Id := 2;
    -- Register the test components
    Component.Initialize;
    Component1.Launch;
    Component2.Launch;
    Component3.Launch;
    Component4.Launch;
    Component5.Launch;

    Threads.Create; -- Do this after the threads have been created.

  end Test6;

Component1 is declared in the Test package body as
  -- first Component thread for test6
  package Component1 is

    Queue1 : Itf.V_Short_String_Type
           := ( Count => 2,
                Data  => "Q1                  " );

    procedure AnyMessage
    ( Message : in Itf.MessageType );

    package DisburseQueue
    -- Instantiate disburse queue for component
    is new Disburse( QueueName => Queue1'Address,
                     Periodic  => True,
                     Universal => AnyMessage'Address,
                     Forward   => System.Null_Address );

    procedure Launch;

  end Component1;
Normally, only the Launch procedure would be declared in the package specification to allow the various components to be "installed" into the message delivery framework.  The Disburse queue is made visible to other component packages so that messages can be delivered without the Delivery Publish mechanism while waiting to translate other C# classes to Ada.

  package body Component1 is

    ComName1 : Itf.V_Medium_String_Type
    := ( Count => 4,
         Data  => "Com1                                              " );
    Result : Component.RegisterResult;

    package Timer
    -- Instantiate PeriodicTimer for this component
    is new PeriodicTimer( Index => 1 );

    procedure Main -- callback
    ( Topic : in Boolean := False );

    procedure Launch is
      function to_Callback is new Unchecked_Conversion
                                  ( Source => System.Address,
                                    Target => Topic.CallbackType );
    begin -- Launch
      Result :=
        Component.Register
        ( Name     => ComName1,
          Period   => 2000, -- # of millisec at which Main procedure to cycle
          Priority => Threads.NORMAL, -- Requested priority of thread
          Callback => to_Callback(Main'Address), -- Callback procedure of component
          Queue    => DisburseQueue'Address );
      DisburseQueue.ProvideWaitEvent( Event => Result.Event );

    end Launch;

    procedure Main -- callback
    ( Topic : in Boolean := False
    ) is

      Success : Boolean;
      Timer_Sec
      -- System time seconds as ASCII
      : String(1..3);
      System_Time
      -- System time
      : ExecItf.System_Time_Type;
    begin -- Main
      Text_IO.Put_Line("in Component1 callback");
      loop -- wait for event

        DisburseQueue.EventWait;

        System_Time := ExecItf.SystemTime;
        CStrings.IntegerToString(System_Time.Second, 2, Timer_Sec, Success);
        Text_IO.Put("C1 ");
        Text_IO.Put_Line(Timer_Sec(1..2));
      end loop;
    end Main;

    -- Treat any message of component
    procedure AnyMessage
    ( Message : in Itf.MessageType
    ) is

      Success : Boolean;
      Iteration : String(1..5);

    begin -- AnyMessage
      Text_IO.Put("Entered Component1 AnyMessage ");
      CStrings.IntegerToString(Message.Header.ReferenceNumber, 4,
                               Iteration, Success);
      Text_IO.Put(Iteration(1..4));
      Text_IO.Put(" ");
      Text_IO.Put_Line(Message.Data(1..2));
    end AnyMessage;

  end Component1;
where, as mentioned above, the disburse queue is declared in the package spec to be visible to other dummy components that will write messages to the queue since the Delivery package has yet to be translated to Ada.  Thus the Main callback's forever loop will announce via the Text IO when it executes.  Since this output is after the call to EventWait, the output will follow that of the AnyMessage procedure that will announce the forwarded message.  An actual component would, of course, determine the topic of the message and do something as a result of receiving the message of the topic.  Component1 is a periodic component since it passes 2000 msec to Register which the declaration of the Disburse queue also notes.

Component5 is an example of declaring a Forward Table.
  -- fifth Component thread for test6
  package Component5 is

    Queue5 : Itf.V_Short_String_Type
           := ( Count => 2,
                Data  => "Q5                  " );

    procedure AnyMessage
    ( Message : in Itf.MessageType );

    -- Declared here so can be referenced to send messages to it
    ForwardTable : Itf.DisburseTableType;
    package DisburseQueue
    -- Instantiate disburse queue for component
    is new Disburse( QueueName => Queue5'Address,
                     Periodic  => False,
                     Universal => AnyMessage'Address,
                     Forward   => ForwardTable'Address );

    procedure Launch;

    procedure Main -- callback
    ( Topic : in Boolean := False
    );

  end Component5; -- fifth Component thread for test6

  package body Component5 is

    ComName5 : Itf.V_Medium_String_Type
    := ( Count => 4,
         Data  => "Com5                                              " );

    Result : Component.RegisterResult;

    procedure Topic1( Message : in Itf.MessageType );
    procedure Topic2( Message : in Itf.MessageType );
    procedure Topic3( Message : in Itf.MessageType );

    procedure Launch is
      function to_Callback is new Unchecked_Conversion
                                  ( Source => System.Address,
                                    Target => Topic.CallbackType );
      function to_Forward is new Unchecked_Conversion
                                 ( Source => System.Address,
                                   Target => Itf.ForwardType );
    begin -- Launch

      ForwardTable.Count := 3;
      ForwardTable.List(1).TopicId := ( Topic.TEST2, Topic.DEFAULT );
      ForwardTable.List(1).Forward := to_Forward(Topic1'Address);
      ForwardTable.List(2).TopicId := ( Topic.DATABASE, Topic.DEFAULT );
      ForwardTable.List(2).Forward := to_Forward(Topic2'Address);
      ForwardTable.List(3).TopicId := ( Topic.OFP, Topic.KEYPUSH );
      ForwardTable.List(3).Forward := to_Forward(Topic3'Address);

      Result :=
        Component.Register
        ( Name     => ComName5,
          Period   => 0, -- not periodic
          Priority => Threads.LOWER, -- Requested priority of thread
          Callback => to_Callback(Main'Address), -- Callback procedure of component
          Queue    => DisburseQueue'Address );
      DisburseQueue.ProvideWaitEvent( Event => Result.Event );

    end Launch;

    procedure Main -- callback
    ( Topic : in Boolean := False
    ) is

      Message : Itf.MessageType;
      Iteration : String(1..5);
      Success : Boolean;

      Timer_Sec
      -- System time seconds as ASCII
      : String(1..3);
      System_Time
      -- System time
      : ExecItf.System_Time_Type;

    begin -- Main
      Text_IO.Put_Line("in Component5 callback");
      loop -- wait for event
        DisburseQueue.EventWait;

        if DisburseQueue.Unread then
          Message := DisburseQueue.Read;
          Text_IO.Put("Com5 message read from queue ");
          CStrings.IntegerToString(Message.Header.ReferenceNumber, 4,
                                   Iteration, Success);
          Text_IO.Put(Iteration(1..4));
          Text_IO.Put(" ");
          Text_IO.Put_Line(Message.Data(1..2));
        end if;

        System_Time := ExecItf.SystemTime;
        CStrings.IntegerToString(System_Time.Second, 2, Timer_Sec, Success);
        Text_IO.Put("C5 ");
        Text_IO.Put_Line(Timer_Sec(1..2));

      end loop;
    end Main;

    -- Treat any message of the component that doesn't have its own procedure
    procedure AnyMessage
    ( Message : in Itf.MessageType
    ) is

      Success : Boolean;
      Iteration : String(1..5);

    begin -- AnyMessage
      Text_IO.Put("Entered Component5 AnyMessage ");
      CStrings.IntegerToString(Message.Header.ReferenceNumber, 4,
                               Iteration, Success);
      Text_IO.Put(Iteration(1..4));
      Text_IO.Put(" ");
      Text_IO.Put_Line(Message.Data(1..2));
    end AnyMessage;

    procedure Topic1( Message : in Itf.MessageType ) is
    begin -- Topic1

      Text_IO.Put( "Entered Component5 Topic1 ");
      Text_IO.Put_Line( Message.Data(1..2) );

     end Topic1;

    procedure Topic2( Message : in Itf.MessageType ) is
    begin -- Topic2

      Text_IO.Put( "Entered Component5 Topic2 ");
      Text_IO.Put_Line( Message.Data(1..2) );

    end Topic2;

    procedure Topic3( Message : in Itf.MessageType ) is
    begin -- Topic3

      Text_IO.Put( "Entered Component5 Topic3 ");
      Text_IO.Put_Line( Message.Data(1..2) );

    end Topic3;

  end Component5;
where, again, the disburse queue is declared in the package spec to be visible to other dummy components that will write messages to the queue.  Thus the Main callback's forever loop will announce via the Text IO when it executes.  Component5 is a component to receive its messages as they are queued since it passes 0 for the component's period interval to Register which the declaration of the Disburse queue also notes. 

Component5 is an example of having message callbacks by topic.  Three such topics are declared in the forward table with message callback procedures provided for each.  Component5 also illustrates what would be used to read unread messages of other topics in its Main callback forever loop.  This is left over from before the use of AnyMessage was added and so has ceased to be of value.

As can be observed, neither of these components publishes messages to be delivered to other components.  The other dummy components do so by writing directly to queue of the component to receive the message.  Such as
      -- Write 2nd message to Component5
      OutIteration := OutIteration + 1;
      Text_IO.Put("Com4 sending KEYPUSH message to Com5 ");
      Int_IO.Put(OutIteration);
      Text_IO.Put_Line(" ");
      OutMessage.Header.CRC := 0;
      OutMessage.Header.Id.Topic := Topic.OFP;
      OutMessage.Header.Id.Ext := Topic.KEYPUSH;
      OutMessage.Header.From.AppId := 2;
      OutMessage.Header.From.ComId := 4;
      OutMessage.Header.From.SubId := 0;
      OutMessage.Header.To.AppId := 2;
      OutMessage.Header.To.ComId := 5;
      OutMessage.Header.To.SubId := 0;
      OutMessage.Header.ReferenceNumber := OutIteration;
      OutMessage.Header.Size := 2;
      OutMessage.Data(1..2) := "C4";
      OutMessage.Data(3) := ASCII.NUL;
      Ok := Component5.DisburseQueue.Write( Message => OutMessage );
by Component4 which announces when the message is being "sent".  This isn't done in the C# application since components aren't supposed to be aware of each other.  The need for this will cease as the translation continues.

A sample of the text output is
. . .
Threads ComponentThread
in TimerProcedure for 4
in Component4 callback
Com4 sending DATABASE message to Com5           1 ß Component4 queuing a message topic
Disburse Write Q5
doing EventWait Q5         176
Com4 sending KEYPUSH message to Com5           2  ß Component4 queuing another topic
Entered ForwardMessage
Found Topic and Ext match in Forward Table
Entered Component5 Topic2 C4                 ß Component5 doing a message callback
Disburse Write Q5
doing EventWait Q5 Entered ForwardMessage
Found Topic and Ext match in Forward Table
Entered Component5 Topic3 C4                 ß Component5 doing a different callback
        176
C5 12
C5 12
C4 12                                        ß Component4 at 12 seconds
C1 Com4 sending DATABASE message to Com5           3 ß Component4 queuing 1st topic
12
Disburse Write Q5
doing EventWait Q5         176
Com4 sending KEYPUSH message to Com5           4     ß and queuing its 2nd topic
Disburse Write Q5
doing EventWait Q5         176
Entered ForwardMessage
Found Topic and Ext match in Forward Table
Entered Component5 Topic2 C4
C4 12
Entered ForwardMessage
Found Topic and Ext match in Forward Table
Entered Component5 Topic3 C4
C5 12
C5 12
C1 14                                        ß Component1 at 14 seconds
Com4 sending DATABASE message to Com5           5
C1 16                                        ß Component1 at 16 seconds
. . .

The sample output illustrates Component4 queuing messages to Component5 of two different topics and Component5 receiving them in two of its three message callbacks.  The third topic is queued by a different component as illustrated by
Com3 sending TEST message to Com5           1
Disburse Write Q5
doing EventWait Q5         176
Entered ForwardMessage
Found Topic and Ext match in Forward Table
Entered Component5 Topic1 C3

The periodic Component1 getting messages is illustrated by Component2 queuing a message and later Component1 getting the message
Disburse Write Q1
Com2 queued message to Com1
. . .
Entered ForwardMessage
Invoking Universal for C2
Entered Component1 AnyMessage    3 C2
when its periodic interval elapses.  The output isn't in sync since there are multiple Text_IO Put and Put_Line statements for a particular output so another thread can run in between.





No comments: