External Components – Database Queries

As I began to think about adding the ability to access a database to the Exploratory Project I was aware that I would need to use a language that had APIs to interface to databases.  

There is a GNAT Ada supported way of accessing databases as described in section 23 of the GNATColl document at http://docs.adacore.com/gnatcoll-docs/sql.html.  However, I don't want to get involved with learning it at the present time.  However, it supports access to PostgreSQL and SQLite which can be interfaced via Windows or Linux so will have to look into the use of those databases some time.

What I'll do next is to provide an interface to a database software system to implement queries.

Instead of using an Ada interface, at least to start with, I will treat a C# application in a manner somewhat similar to how the C# display application is currently treated.  That is, more or less like an external/isolated component – meaning a framework component that is external to the user application. 

This due to the C# processes not having access to user application framework.  Since they lack the access they can't register themselves with the framework not the message topics that they consume or produce. 

This could be remedied via the use of a C or C++ component to access the database.  Microsoft Visual C++, at least, has the use of the Microsoft libraries that support SQL database access.  So I could go that route if I wanted to find out how to reference those libraries in a GNAT build.  Maybe later.  Although, most likely it will be using the GNAT support that GNATColl provides.

But first I will look into providing the use of paired application processes of independent builds where one provides the use of the framework and its interface to other user applications enabling any user application to send topic messages and the second application process of the pair, the external component, actually interfaces to the database.

Proposed Architecture:

The user application architecture that I'm thinking of is to clone that used in the current Exploratory Project for communication with the display app.

That is, like the display app – which can now be referred to as the external display component where "external" means that the component is in its own build rather than part of the application build. 

As with the external display component there will be one or more external database components as required.  These can be like the A661 layers that paint different displays or display areas when multiple databases are concerned.  For lack of any better descriptor to use at the moment I will refer to the database equivalent of an A661 layer as a database box (in the sense of a container).

Likewise, there will be an internal/local database component to manage a particular box.  This will correspond to the GUI_n component for interfacing to A661 layer n.

The A661 layers are defined by the xml display definition file that is loaded into both the user application and the external display component.  In the user application it is parsed to discover the widget ids that can be sent for widget events and the graphical items that can be displayed or hidden.  The result is stored in a table of the Widget package and used in conjunction with widget action components that act upon a particular widget event.  The GUI_n component can then do a lookup to determine what widget action component treats the widget event and forward the received message to it.  The widget action will then create a widget command message and return it to the layer management component for transmit to the display layer.

My current thinking is that something similar can be done in regards to a database.  Except that other user components will be the initiators rather than operator widget clicks and the like.

A local or remote user component will want a piece of information and send a request topic to have it returned to it.  The component that registers to consume the topic could supply the information for computations or such that it performs or, in this case, be the database management component. 

If the latter, it could look up a local query action component that would format the query into SQL and forward the SQL message back to the database management component which would than transmit it to the external database component.  The external database component would just need to interface to the database via the query (after connecting to the database, if currently not connected) and return the result to the database management component.  The database management component could then forward the response to the particular query action component to interpret the response and extract the data that satisfies the original request.  It would then publish the response to the original request just as if it had been locally available.

The query actions most likely do not need to be components – that is, have their own thread.  Instead, just callback procedures running under the database management component thread.

This initial work is just to interface to a database rather than to determine what queries should look like.  Therefore, user components will send Context Filtered or Requested Delivery message topics without knowing how the requested item might be stored and found.  It will be the consumer component that has this knowledge in the Query Action (QA) procedures which are hidden from the requesting component.  Therefore, the requesting component can't form a SQL query; the Query Action will do so.

As with the A661 layer management component, the query management component (DBI_n) it looks up the query action associated with the topic in the SQL package table by the identifier in the request topic message.  The table is built from a database schema as well as application specific data such as which Query Action that treats the request topic message.

Similarly for a database, the xml could be replaced by the database schema and used to build a Schema package table that would also reference SQL Query Action procedures of the Database management application.  Upon receiving a request from another component, the Database management component of the Database management application, could forward the message to the particular SQL Query Action component that would build the SQL query and return it to the management component to transmit to the external component / database application (or, with SQLite, the internal component). 

That's the idea.  Now to determine if it works.

Exploratory Project – One app for both Windows and Linux

Exploratory Project – One app for both Windows and Linux

After a number of iterations and delays I have finally morphed my exploratory project from a Windows based set of applications (loadable processes) to one to run under Linux and now, at last, to one set of procedures and functions that, except for one interface package, that can build applications to run under either operating system.

The one interface package body exec_itf, written in Ada, has two versions – the one for use with Windows and the one to use with Linux.  There are a few other packages that contain code that takes different paths that are dependent upon the op sys under which the application is running.  These can be used without change for use with either Windows or Linux.

All unit file names are now in lower case to satisfy Linux whereas case doesn't matter for Windows.  Also, all references to the Win32Ada source files have been removed from the build files.

In addition there are two C# applications that are used to interface with the display.  These are one and the same except for the named pipe interface used to communicate with the Ada worker applications; MS Pipes for Windows and the mkfifo named pipes for Linux.  This application of the project is written in Visual C# Express for Windows and uses MonoDevelop as a .NET application for Linux.

Brief History:

The Exploratory Project started out to produce a Windows based framework for producing applications.  The framework is used to isolate user components from each other with message topics to communicate between the components rather than the use of common memory.  In addition, in the exploratory project, the components can be moved from one application (separate build) to another with the framework detecting the particular component and its application upon startup.  This is possible since the components don't share memory, just like applications that use the internet to communicate.

See the three part article “Building an effective real time publish-subscribe framework” of Rajive Joshi in Embedded.com of Aug 9, Aug 14, and Aug 21, 2006 for one source of background material about the concept.  {http://www.embedded.com/design/connectivity/4006689/Building-a-effective-real-time-distributed-publish-subscribe-framework-Part-1 for instance.}

A number of previous posts to this blog have to do with creating the framework and then a variation of it oriented towards communicating with the display app (CDS) via the communications protocol of the ARINC-661 standard {e.g., http://read.pudn.com/downloads111/ebook/462188/ARINC661-2005.pdf} to replace the home grown protocol that was originally used. 

The initial Exploratory Project had a display app that could treat multiple display layers with each interfacing to its own user application.  With the change to use as an example of a user application with a different structure for the components that interface with the A661 protocol display {for instance, see past blog posts such as Using A661 in a Windows PC Environment – part 1 of July 31, 2012}, only one display layer was used.  In the future, the current version of the Exploratory Project may be expanded to treat multiple layers once again with multiple user applications each treating a layer or a particular user application treating more than one layer (as illustrated in the July 31 post and below).

Starting with the Using Windows-like Events in Linux post of August 29, 2012 this modification of the Exploratory Project began to be moved to execute with interfacing to the Linux operating system.   Now the changes have been made to allow the same set of program units to be used for a build to be run under either Windows or Linux (except for the one unit that acts as the direct interface to the particular op sys).

Windows/Linux Interface:

Communications:

Other than the interface to the op sys the main difference between the Windows version and the Linux version is the method used to communicate between the various loadable application processes.  (Within a particular user application, the framework is used.) 

For Windows, Microsoft Pipes (MS Pipes) are used.  With Linux, the mkfifo named pipes are used.  (Note, MS Pipes are also named pipes). 

For the single set of program units, the code to use either kind of named pipes is included in the build with only one or the other selected at run time depending upon which op sys is being used.  Two methods of selecting the named pipe packages are used depending upon whether communicating between other user apps or whether communicating with the CDS display app for a particular display layer.  That between other user apps uses the framework while that between a user app and the CDS uses an instance of an Ada generic for each layer.

Inter-User App Communications:

To communicate with other user apps that are based upon the framework, a private subpackage (Remote) of the framework is used – that is, one not visible to user components.  Within this private subpackage is another Method child package that is used to select the communication method to be used.  Each communication method has its own child package, MS_Pipe and Named_Pipe in this case.  (Another method of WinSock is left over from before the Exploratory Project forked off to use the A661 protocol.  This can be restored at any time with a complementary package for Linux oriented TCP/IP internet sockets.)

To select the procedures of the correct communication method, a table is provided as follows.

separate( mC.Message.Remote )

package body Method is

  type Communication_Direction_Type

  is ( Receive,

       Transmit );

  . . .

  package MS_Pipe is

  --| Communicate Between Applications Using Microsoft Pipes

  -- ++

  --| Overview:

  --|   This package is to be used by communication packages and procedures

  --|   to communicate between applications using Microsoft Pipes.

  --|

  --|   Each application of an application pair will act as the Server for

  --|   one of a pair of pipes between the application pair and as the Client

  --|   for the pipe.

  --|

  --|   The Client will send/transmit/write a message to the Server for the

  --|   Server to respond to.  (The example has the Server waiting upon a

  --|   message and then sending a reply.  The Client does a Write and then

  --|   waits for the reply.)

  --|

  --|   Therefore, for the pipe where an application will transmit to the

  --|   other application, the first application will be the client and the

  --|   receiving application will be the server for the pipe.

  --|

  --|   Thus, for each application, the Client Open will be invoked for the

  --|   pipe to which it will transmit and the Server Open will be invoked

  --|   for the pipe for which it will wait for a receive.

  --|

  --|   Each pipe of the pair has to have a unique name.  For the application

  --|   pair 1 and 2, it application 1 is to transmit it will be the client

  --|   and application 2 will receive and be the server.  But each must use

  --|   the same pipe name.  Therefore, a name such as App 1 to App 2 might

  --|   be appropriate since such a name implies that App 1 will transmit and

  --|   App 2 will receive.

  --|

  --|   For connections of the user app to a display app, the base portion of

  --|   the name is obtained from the Apps-Configuration file and the layer

  --|   that the user application connects with is obtained from the file and

  --|   use in the name so different user apps will use different pairs of

  --|   pipes.

  -- --

    procedure Close_Connection

    ( Index : in Apps.Configuration.Connection_Index_Type

      --| Index of connection in Comm Pipe table for Receive

    );

    --| Close MS Pipe Connection

    -- ++

    --| Overview:

    --|   This procedure closes the connection identified by the Index.

    -- --

    procedure Find_Remote_App( Pointless : in Boolean := True );

    --| Find Remote Applications that can communicate with this application

    -- ++

    --| Overview:

    --|   This procedure determines what remote applications are running that

    --|   can communicate with this application via MS Pipes.

    -- --

    procedure Initialize

    ( Method    : in mC.Itf_Types.Supported_Communication_Method_Type;

      --| Supported communication method of local application

      App_Ident : in Apps.Application_Id_Type

      --| Identifier of running application

    );

    --| Initialize

    -- ++

    --| Overview:

    --|   This procedure performs the necessary initializations.

    -- --

    procedure Install( Pointless : in Boolean := True );

    --| Install

    -- ++

    --| Overview:

    --|   tbd

    -- --

    procedure Quit( Pointless : in Boolean := True );

    --| Terminate Communications

    -- ++

    --| Overview:

    --|   This procedure performs the necessary termination functions.

    -- --

    procedure Receive

    ( Topic : in Boolean := False

    );

    --| Receive thread to read from the other application of application pair

    -- ++

    --| Overview:

    --|   This function is the reader thread that reads from the Microsoft

    --|   Pipe, queues topic messages, and signals the Producer Proxy to

    --|   interpret the message and publish it as a topic.

    -- --

    procedure Transmit

    ( Remote_App : in Apps.Component_Selector_Type;

      --| Remote application to which to transmit

      Count      : in Message_Size_Type;

      --| Total number of bytes in message including header

      Message    : in System.Address

      --| Message to be transmitted

    );

    --| Transmit to other application of the application pair

    -- ++

    --| Overview:

    --|   This procedure runs under the mC Message Remote Main thread to

    --|   transmit a message to the other application of the pair.

    -- --

  end MS_Pipe;

  ---------------------------------------------------------------------------

  package Named_Pipe is

  --| Communicate Between Applications Using Linux Named (fifo) Pipes

  -- ++

  --| Overview:

  . . . clone of the above declaring the MS_Pipe interface

  end Named_Pipe;

  ---------------------------------------------------------------------------

  --| Notes:

  --|   Access procedure pointers.

  type Remote_Thread_Ptr_Type

  --| Procedure access to communication method

  is access procedure( Pointless : in Boolean := True );

  type Remote_Close_Ptr_Type

  --| Access to close connection of communication method

  is access procedure( Index : in Apps.Configuration.Connection_Index_Type

                       --| Index of connection in its table

                     );

  type Remote_Initialize_Ptr_Type

  --| Access to initialize communication method

  is access procedure

  ( Method    : in mC.Itf_Types.Supported_Communication_Method_Type;

    --| Supported communications methods of application

    App_Ident : in Apps.Application_Id_Type

    --| Identifier of running application

  );

  type Remote_Transmit_Ptr_Type

  --| Access to transmit communication method

  is access procedure( Remote  : in Apps.Component_Selector_Type;

                       --| Remote destination of message

                       Count   : in Message_Size_Type;

                       --| Total number of bytes to transmit including header

                       Message : in System.Address

                       --| Message to be transmitted

                     );

  type Remote_Procedures_Type

  --| One common access procedure per communication method

  is array( mC.Itf_Types.Communication_Method_Type )

  of Remote_Thread_Ptr_Type;

  type Remote_Close_Type

  --| One common access procedure per communication Close Connection method

  is array( mC.Itf_Types.Communication_Method_Type )

  of Remote_Close_Ptr_Type;

  type Remote_Initialize_Type

  --| One common access procedure per communication Initialize method

  is array( mC.Itf_Types.Communication_Method_Type )

  of Remote_Initialize_Ptr_Type;

  type Remote_Transmit_Type

  --| One common access procedure per Topic protocol communication Transmit

  --| method

  is array( mC.Itf_Types.Communication_Method_Type )

  of Remote_Transmit_Ptr_Type;

  type Remote_Procedures_Table_Type

  is record

    Close      : Remote_Close_Type;

    Install    : Remote_Procedures_Type;

    Initialize : Remote_Initialize_Type;

    Quit       : Remote_Procedures_Type;

    Find_App   : Remote_Procedures_Type;

    Transmit   : Remote_Transmit_Type;

  end record;

  type Remote_Procedures_Array_Type

  is array ( Exec_Itf.Windows .. Exec_Itf.Linux )

  of Remote_Procedures_Table_Type;

  Invoke

  --| Table of top-level communication method procedures

  --| Notes:

  --|   This table must be changed depending on the Op Sys being used.

  : Remote_Procedures_Array_Type

  := ( Exec_Itf.Windows =>

        ( Close        =>

            ( mC.Itf_Types.Pipes   => MS_Pipe.Close_Connection'access,

              mC.Itf_Types.Sockets => null ),

          Install      =>

            ( mC.Itf_Types.Pipes   => MS_Pipe.Install'access,

              mC.Itf_Types.Sockets => null ),

          Initialize   =>

            ( mC.Itf_Types.Pipes   => MS_Pipe.Initialize'access,

              mC.Itf_Types.Sockets => null ),

          Quit         =>

            ( mC.Itf_Types.Pipes   => MS_Pipe.Quit'access,

              mC.Itf_Types.Sockets => null ),

          Find_App     =>

            ( mC.Itf_Types.Pipes   => MS_Pipe.Find_Remote_App'access,

              mC.Itf_Types.Sockets => null ),

          Transmit     =>

            ( mC.Itf_Types.Pipes   => MS_Pipe.Transmit'access,

              mC.Itf_Types.Sockets => null ) ),

       Exec_Itf.Linux   =>

        ( Close        =>

            ( mC.Itf_Types.Pipes   => Named_Pipe.Close_Connection'access,

              mC.Itf_Types.Sockets => null ),

          Install      =>

            ( mC.Itf_Types.Pipes   => Named_Pipe.Install'access,

              mC.Itf_Types.Sockets => null ),

          Initialize   =>

            ( mC.Itf_Types.Pipes   => Named_Pipe.Initialize'access,

              mC.Itf_Types.Sockets => null ),

          Quit         =>

            ( mC.Itf_Types.Pipes   => Named_Pipe.Quit'access,

              mC.Itf_Types.Sockets => null ),

          Find_App     =>

            ( mC.Itf_Types.Pipes   => Named_Pipe.Find_Remote_App'access,

              mC.Itf_Types.Sockets => null ),

          Transmit     =>

            ( mC.Itf_Types.Pipes   => Named_Pipe.Transmit'access,

              mC.Itf_Types.Sockets => null ) )

     );

A sample communication method selection procedure is

 procedure Find_Remote_App is

   use type mC.Itf_Types.Supported_Communication_Method_Type;

 begin -- Find_Remote_App

   --| Logic_Step:

   --|   Find remote applications that can communicate with this

   --|   application.

   --| Notes:

   --|   Can only be done for MS Pipes or Named Pipes to determine

   --|   what remote applications are running.  WinSock has a null

   --|   procedure.

   if Supported_Method = mC.Itf_Types.Both then

     for M in mC.Itf_Types.Communication_Method_Type loop

       if Invoke(Exec_Itf.Op_Sys).Find_App(M) /= null then

         Invoke(Exec_Itf.Op_Sys).Find_App(M)( Pointless => True );

       end if;

     end loop;

   elsif Supported_Method /= mC.Itf_Types.None then

     Invoke(Exec_Itf.Op_Sys).Find_App(Supported_Method)( Pointless => True );

   end if;

 end Find_Remote_App;

The currently running operation system is named by the globally visible Op_Sys variable of the Exec_Itf package.  Supported_Method is the communications method supported by the application.  That is, Pipes or Sockets or, if both methods are supported then Both.  These array indexes select the table item to be invoked.

A661 User/Display App Communications:

To communicate between a user apps and the display app, an Ada generic package is used; that is, one that can be instantiated multiple times where each instantiation has its own data space but uses the same code.  This is done to allow the use of a unique instantiation for each display layer.

In the user program structure depicted by the following reproduction of that of the Using A661 in a Windows PC Environment – part 1 blog post, the top level interface to manage a particular layer is represented by GUI Layer n to manage layer n. 

In the following code samples, the Display_Pipe generic package takes the place of "comm Method" in the figure.  When instantiated by GUI1 (GUI Layer 1 of the figure), it instantiates an instance of both the MS_Pipe and Named_Pipe generic packages (rather than only MS Pipe of the figure).  (Note:  The same names are used as for the framework packages for inter-user app communications.  However, these are stand alone packages whereas these names in the framework are child packages of the Remote Method package.)

package body GUI1 is

  Layer_Id

  --| Layer identifier that this component manages

  : constant A661.Types.Layer_Id_Type := 1;

  . . .

  procedure Add_to_Received_Messages_Queue

  ( Length  : in Integer;

    --| Number of bytes of Message to be used

    Message : in A661.Types.Generic_Message_Type;

    --| Received message

    Valid   : out Boolean

    --| True if message added to the queue

  );

  --| Add Message to Queue and Publish Wakeup Event

  -- ++

  --| Overview:

  --|   This procedure queues the received A661 message and publishes the

  --|   wakeup event topic to cause the GUI1 component to execute.

  --| Limitations:

  --|   This procedure runs under the Driver Receive thread while the rest

  --|   of the methods of this component run under the component's thread.

  --|   Therefore, this procedure and the one that Gets a message from the

  --|   queue must execute in a thread safe manner.

  -- --

  package Driver

  --| Instantiate MS_Pipe communications driver for layer 1

  is new Display_Pipe

  ( Id                            => Layer_Id,

    Add_Received_Message_to_Queue => Add_to_Received_Messages_Queue'access,

    Register_Component            => mC.Itf.Register_Component'access );

  . . .

  procedure Initialize

  ( User_Name : in Apps.Application_Name_Type;

    User_Id   : in Apps.Application_Id_Type

  ) is

    . . .

    Driver.Initialize( User_Id    => User_Id,

                       Display_Id => Display_Id,

                       Port_Name  => Port_Name );

  end Initialize;

  . . .

end GUI1;

Other GUI1 procedures also call the Driver instantiation of Display_Pipe such as GUI1's Install procedure calling that of Driver and various procedures calling Driver Transmit.

The Display_Pipe package spec (that is, the visible interface) is

with A661;

with Apps;

with mC.Itf_Types;

generic

-- ++

--| Overview:

--|   Generic package to communicate, when instantiated, with the Display

--|   Application for a particular layer.

-- --

  --| Notes:

  --|   Parameters to supply when instantiate an instance of a topic.

  Id

  --| Layer identifier

  : A661.Types.Layer_Id_Type;

  Add_Received_Message_to_Queue

  --| Callback to Add a Received Message to its Received Messages Queue

  : A661.Add_Received_Message_to_Queue_Type;

  Register_Component

  --| Callback to Register the Receive component

  : A661.Register_Component_Type;

package Display_Pipe is

-- ++

--| Overview:

--|   Package to access to either read or write a selected named pipe as the

--|   pipe client or the pipe server.  The use, by an application, of either

--|   the client or the server and the use, by a different application, of

--|   the reverse instantiation, will result in a full duplex pipe with the

--|   pair of applications being able to communicate with each other when

--|   both are running under Windows or Linux on the same PC.

--|

--|   At open, specify a number for each of a pair of applications; the

--|   currently running application as the Client and the other application

--|   as the Server.  If the other application does the same it will also

--|   name itself as the Client and the first application as the Server.

--|

--|   When, for instance, application 1 needs to send a request to

--|   application 2, it could have a named pipe called "NamedPipe01to02" as

--|   the Client pipe and will use it to transmit to application 2 and

--|   application 2 will have the same pipe as its Server pipe and use it to

--|   receive from application 1.  While application 2 will have a Client

--|   named pipe named such as "NamedPipe02to01" to use transmit to

--|   application 1 and application 1 will have the same pipe to use to

--|   receive from application 2.

-- --

  procedure Close_Connection;

  --| Close Display Pipe Connection

  -- ++

  --| Overview:

  --|   This procedure closes the connection identified by the Index.

  -- --

  procedure Initialize

  ( User_Id    : in Apps.Application_Id_Type;

    --| User app id of the current app

    Display_Id : in Apps.Application_Id_Type;

    --| App id of the display app

    Port_Name  : in mC.Itf_Types.Port_Name_Type

    --| Port name to access the display layer

  );

  --| Initialize

  -- ++

  --| Overview:

  --|   This procedure performs the necessary initializations and returns the

  --|   name to register the receive component.

  -- --

  procedure Install;

  --| Install

  -- ++

  --| Overview:

  --|   tbd

  -- --

  procedure Quit;

  --| Terminate Communications

  -- ++

  --| Overview:

  --|   This procedure performs the necessary termination functions.

  -- --

  procedure Transmit

  ( Size    : in Natural;

    --| Number of bytes in Message to be transmitted

    Message : in A661.Types.Generic_Message_Type

    --| Message to be transmitted

  );

  --| Transmit to Display Application of the application pair

  -- ++

  --| Overview:

  --|   This procedure runs under the Layer Management thread to transmit a

  --|   message to the Display Application of the application pair.

  -- --

end Display_Pipe;

The package body contains

with Exec_Itf;

with MS_Pipe;

with Named_Pipe;

package body Display_Pipe is

--| Communicate Between this Application as Client of the A661 Display

--| Application

-- ++

--| Overview:

--|   This package is to be used by the A661 display Receive and Transmit

--|   components to supply procedures to communicate between this application

--|   as a client of the Display Application using either MS Pipes for

--|   Windows or Named Pipes for Linux.

--|

--|   It will be instantiated by a Layer Management component for a

--|   particular layer with the use of MS Pipes or Named Pipes determined by

--|   the operating system being used.

--|

--| Notes:

--|   The layer management package for the layer must invoke Initialize prior

--|   to Install.  Install must be invoked before Transmit and the like.

-- --

  type Communications_Pipe_Type

  is ( Windows_Pipe, -- for Windows

       Linux_Pipe ); -- for Linux

  Pipe

  --| Pipe package to be used

  : Communications_Pipe_Type := Windows_Pipe;

  package Pipe_Windows

  --| Instantiate MS_Pipe communications driver for the layer

  is new MS_Pipe

         ( Id                            => Id,

           Add_Received_Message_to_Queue => Add_Received_Message_to_Queue,

           Register_Component            => Register_Component );

 

  package Pipe_Linux

  --| Instantiate Named_Pipe communications driver for the layer

  is new Named_Pipe

         ( Id                            => Id,

           Add_Received_Message_to_Queue => Add_Received_Message_to_Queue );

  procedure Initialize

  ( User_Id    : in Apps.Application_Id_Type;

    --| User app id of the current app

    Display_Id : in Apps.Application_Id_Type;

    --| App id of the display app

    Port_Name  : in mC.Itf_Types.Port_Name_Type

    --| Port name to access the display layer

  ) is

  -- ++

  --| Logic_Flow:

  --|   Determine which named pipe package to call for the operation system

  --|   and then invoke its initialization.

  -- --

    use type Exec_Itf.Op_Sys_Type;

  begin -- Initialize

    if Exec_Itf.Op_Sys = Exec_Itf.Linux then

      Pipe := Linux_Pipe;

    else

      Pipe := Windows_Pipe;

    end if;

    case Pipe is

      when Windows_Pipe    =>

        Pipe_Windows.Initialize;

      when Linux_Pipe =>

        Pipe_Linux.Initialize( User_Id    => User_Id,

                               Display_Id => Display_Id,

                               Port_Name  => Port_Name );

    end case;

  end Initialize;

  procedure Install is

  begin -- Install

    case Pipe is

      when Windows_Pipe    =>

        Pipe_Windows.Install;

      when Linux_Pipe =>

        Pipe_Linux.Install;

    end case;

  end Install;

  procedure Close_Connection is

  begin -- Close_Connection

    case Pipe is

      when Windows_Pipe    =>

        Pipe_Windows.Close_Connection;

      when Linux_Pipe =>

        Pipe_Linux.Close_Connection;

    end case;

  end Close_Connection;

  procedure Quit is

  begin -- Quit

    case Pipe is

      when Windows_Pipe    =>

        Pipe_Windows.Quit;

      when Linux_Pipe =>

        Pipe_Linux.Quit;

    end case;

  end Quit;

  procedure Transmit

  ( Size    : in Natural;

    --| Number of bytes in Message to be transmitted

    Message : in A661.Types.Generic_Message_Type

   --| Message to be transmitted

  ) is

  begin -- Transmit

    case Pipe is

      when Windows_Pipe    =>

        Pipe_Windows.Transmit( Size    => Size,

                               Message => Message );

      when Linux_Pipe =>

        Pipe_Linux.Transmit( Size    => Size,

                             Message => Message );

    end case;

  end Transmit;

end Display_Pipe;

exec_itf:

This is the only package that continues to exist in separate versions for Windows and Linux.  There is a common Ada specification to present the global interface with separate versions for the package body to actually interface with the operating system.

exec_itf.ads:

In the package spec that follows some "pragma Import"s have been retained.  That is, those that both the GNAT Windows and Linux linkers recognize.  The others have been moved to the package body so that its file might be the only one that needs different versions.  Also many type and constant declarations are, most likely, no longer needed.

with Ada.Finalization;

with Ada.Task_Identification;

with GNAT.OS_Lib;

with GNAT.Sockets.Linker_Options; -- needed to link via GNAT to its libwsock32.a library

with Interfaces.C;

with Interfaces.C.Pointers;

with System;

with Unchecked_Conversion;

package Exec_Itf is

  ---------------------------------------------------------------------------

  --| Notes:                                                                |

  --|   Miscellaneous types, constants, and functions.                      |

  ---------------------------------------------------------------------------

  type Op_Sys_Type

  --| Possible operating system (i.e., executive) choices

  is ( Unknown,

       Windows,

       Linux );

  Op_Sys

  --| Operating system supported by this version of the executive

  : Op_Sys_Type := Unknown;

  procedure Set_Op_Sys;

  --| Set Operating System Running Under

  subtype Config_File_Name_Type is String(1..60);

  type Config_File_Name_Var_Type

  is record

    Count : Integer;

    Value : Config_File_Name_Type;

  end record;

  function Config_File_Name

  return Config_File_Name_Var_Type;

  --| Return path name of configuration file

  procedure Exit_to_OS

  ( Status : Integer := 0

  );

  -- Exit to OS with Status

  function GetLastError

  return Integer;

  -- Return current last error number

  type BOOL is new Interfaces.C.Int;             -- same as Win32 BOOL

  subtype CHAR    is Interfaces.C.Char;          -- Win32

  type    PCHAR   is access all CHAR;            -- Win32

  subtype LPSTR   is PCHAR;                      -- Win32

  subtype DWORD   is Interfaces.C.Unsigned_Long; -- same as Win32 DLONG

  subtype ULONG   is Interfaces.C.Unsigned_Long; -- same as Win32 DLONG

  type    PULONG  is access all ULONG;           -- Win32

  subtype PDWORD  is PULONG;                     -- Win32

  subtype LPDWORD is PDWORD;                     -- Win32

  procedure Log_Error;

  -- Log the current last error number

  subtype Computer_Name_Type

  is Integer range 1..200;

  function GetComputerName

  ( Name   : in System.Address;

    --| Location of buffer into which to store the name

    Length : in Computer_Name_Type

    --| Number of characters, including trailing NUL, that can be stored

  ) return Integer; -- 0 if no error

  --| Return the computer / host name on which application is running

  function GetComputerNameA                      -- winbase.h:6576

  ( Buffer : LPSTR;

    Size   : LPDWORD

  ) return BOOL;

  pragma Import( Stdcall, GetComputerNameA, "GetComputerNameA" ); -- winbase.h:6576

  -- GetComputerName and GetComputerNameA are the same function

  type Integer_Pair_Type

  is array( 1..2 ) of Integer;

  function Unsigned_Long_to_Int

  ( Source : in Interfaces.C.Unsigned_Long

  ) return Integer_Pair_Type;

  ---------------------------------------------------------------------------

  --| Notes:                                                                |

  --|   File types, constants, and functions.                               |

  ---------------------------------------------------------------------------

  type File_Handle is private;

  --|  Corresponds to the file handle values used in the C routines

  type Mode_Type

  is ( Binary, Text );

  for Mode_Type'Size use Integer'Size;

  for Mode_Type use ( Binary => 0, Text => 1 );

  -- Used in all the Open and Create calls to specify if the file is to be

  -- opened in binary mode or text mode. In systems like Unix, this has no

  -- effect, but in systems capable of text mode translation, the use of

  -- Text as the mode parameter causes the system to do CR/LF translation

  -- and also to recognize the DOS end of file character on input. The use

  -- of Text where appropriate allows programs to take a portable Unix view

  -- of DOS-format files and process them appropriately.

  Invalid_File_Handle

  --|  File descriptor returned when error in opening/creating file;

  : constant File_Handle;

  function Close_File

  ( Handle : File_Handle

  ) return Boolean;

  -- Close file referenced by Handle. Return False if the underlying service

  -- failed. Reasons for failure include: disk full, disk quotas exceeded

  -- and invalid file handle (the file may have been closed twice).

  subtype PVOID  is System.Address;              -- same as Win32

  subtype HANDLE is PVOID;                       -- winnt.h:144

  function CloseHandle                           -- winbase.h:2171

  ( Object : HANDLE

  ) return BOOL;

  function Create_File

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle;

  -- Creates new file with given name for writing, returning file descriptor

  -- for subsequent use in Write calls. The file handle is returned as

  -- Invalid_Handle if the file cannot be successfully created.

  function Create_New_File

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle;

  -- Create new file with given name for writing, returning file descriptor

  -- for subsequent use in Write calls. This differs from Create_File in

  -- that it fails if the file already exists. File handle returned is

  -- Invalid_Handle if the file exists or cannot be created.

  Seek_Cur : constant := 1; -- seek from current position

  Seek_End : constant := 2; -- seek from end of file

  Seek_Set : constant := 0; -- seek from start of file

  --  Used to indicate origin for Seek call

  procedure Seek

  ( Handle : File_Handle;

    Offset : Long_Integer;

    Origin : Integer

  );

  --  Sets the current file pointer to the indicated offset value, relative

  --  to the current position (origin = SEEK_CUR), end of file (origin =

  --  SEEK_END), or start of file (origin = SEEK_SET).

  pragma Import( C, Seek, "__gnat_lseek" );

  function Open_Read

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle;

  -- Open file Name for reading, returning file handle.  File handle is

  -- returned as Invalid_Handle if file cannot be opened.

  function Open_Read_Write

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle;

  -- Open file Name for both reading and writing, returning file handle.

  -- File handle returned as Invalid_Handle if file cannot be opened.

  type OVERLAPPED;                               -- winbase.h:179

  type LPOVERLAPPED is access all OVERLAPPED;    -- winbase.h:185

  subtype LPVOID  is PVOID;                      -- windef.h

  function ReadFile                              -- winbase.h:2095

  ( File                : HANDLE;

    Buffer              : LPVOID;

    NumberOfBytesToRead : DWORD;

    NumberOfBytesRead   : LPDWORD;

    Overlapped          : LPOVERLAPPED

  ) return BOOL;

  function Read_File

  ( File : File_Handle;

    Addr : System.Address;

    Num  : Integer

  ) return Integer;

  -- Read Num bytes to address Addr from file referenced by File.

  -- Returned value is count of bytes actually read, which can be

  -- less than Num at EOF.

  function Write_File

  --| Write Text to File and return number of bytes written.  Strip internal

  --| NULs if True.

  ( File       : in File_Handle;

    Text       : in String;

    Strip_NULs : in Boolean := False

  ) return Integer;

  function Write_File

  --| Write Len bytes at Addr to File and return number of bytes written.

  ( File : File_Handle;

    Addr : System.Address;

    Len  : Integer

  ) return Integer;

  ---------------------------------------------------------------------------

  --| Notes:                                                                |

  --|   Time types, constants, and functions.                               |

  ---------------------------------------------------------------------------

  -- The following types are duplicates of those in GNAT s-os_lib.ads.

  subtype OS_Time is GNAT.OS_Lib.OS_Time; --private;

  --  The OS's notion of time is represented by the private type OS_Time.

  --  This is the type returned by the File_Time_Stamp functions to obtain

  --  the time stamp of a specified file. Functions and a procedure (modeled

  --  after the similar subprograms in package Calendar) are provided for

  --  extracting information from a value of this type. Although these are

  --  called GM, the intention is not that they provide GMT times in all

  --  cases but rather the actual (time-zone independent) time stamp of the

  --  file (of course in Unix systems, this *is* in GMT form).

  subtype SystemTimeType is OS_Time;

  Invalid_Time : constant OS_Time := GNAT.OS_Lib.Invalid_Time;

  --  A special unique value used to flag an invalid time stamp value

  subtype Year_Type     is Integer range 1900 .. 2099;

  subtype Month_Type    is Integer range    1 ..   12;

  subtype Day_Type      is Integer range    1 ..   31;

  subtype Hour_Type     is Integer range    0 ..   23;

  subtype Minute_Type   is Integer range    0 ..   59;

  subtype Second_Type   is Integer range    0 ..   59;

  subtype Millisec_Type is Integer range    0 ..  999;

  --  Declarations similar to those in Calendar, breaking down the time

  function Current_Time

  return OS_Time;

  --  Return the system clock value as OS_Time

  type Split_Time_Type

  --| Structure with the Data and Time.

  --| Notes: Not part of GNAT but similar to C tm type.

  --|        Also, like SYSTEMTIME of System.Win32 except each field was of

  --|        type WORD where WORD is declared as Interfaces.C.unsigned_short

  --|        where type unsigned_short is mod 2 ** short'Size; and short is

  --|        type short is new Short_Integer;

  is record

    Year     : Year_Type;

    Month    : Month_Type;

    Day      : Day_Type;

    Hour     : Hour_Type;

    Minute   : Minute_Type;

    Second   : Second_Type;

    Millisec : Millisec_Type;

  end record;

  subtype System_Time_Type is Split_Time_Type;

  function System_Time

  ( Time : OS_Time

    --| System clock value

  ) return System_Time_Type;

  --| Return system clock value as a record.

  --| Notes: This time contains no adjustment for local time.

  type FILETIME;                                 -- winbase.h:204

  type SYSTEMTIME1;                       -- same as Win32.WinBase SYSTEMTIME

  type PFILETIME is access all FILETIME;         -- winbase.h:207

  subtype LPFILETIME is PFILETIME;               -- winbase.h:207

  type PSYSTEMTIME is access all SYSTEMTIME1;    -- winbase.h:222

  subtype LPSYSTEMTIME is PSYSTEMTIME;           -- winbase.h:222

  procedure GetSystemTime                        -- winbase.h:2613

  ( SystemTime : LPSYSTEMTIME );

  pragma Import( Stdcall, GetSystemTime, "GetSystemTime" ); -- winbase.h:2613

  function SystemTime

  return System_Time_Type;

  --| Return system clock value as a record.

  --| Notes: This time contains no adjustment for local time.

  procedure GM_Split

  ( Date     : OS_Time;

    Year     : out Year_Type;

    Month    : out Month_Type;

    Day      : out Day_Type;

    Hour     : out Hour_Type;

    Minute   : out Minute_Type;

    Second   : out Second_Type;

    Millisec : out Millisec_Type

  );

  --  Analogous to the Split routine in Ada.Calendar, takes an OS_Time and

  --  provides a representation of it as a set of component parts, to be

  --  interpreted as a date point in UTC.

  function File_Time_Stamp

  ( Name : String

  ) return OS_Time;

  --  Given the name of a file or directory, Name, obtains and returns the

  --  time stamp. This function can be used for an unopened file. Returns

  --  Invalid_Time is Name doesn't correspond to an existing file.

  function File_Time_Stamp

  ( Handle : File_Handle

  ) return OS_Time;

  --  Get time stamp of file from file Handle and returns Invalid_Time if

  --  Handle doesn't correspond to an existing file.

  ---------------------------------------------------------------------------

  --| Notes:                                                                |

  --|   Process types, constants, and functions.                            |

  ---------------------------------------------------------------------------

  type PId_t is private;

  Invalid_PId : constant PId_t;

  function GetPId return PId_t;

  -- This function gets system identifier of the current process / application.

  pragma Import (C, GetPId, "getpid");

  function Execute_Program

  ( Name : in String

    --| Program name to be executed

  ) return PId_t;

  --| Spawn a new Process and Execute the Command

  -- ++

  --| Overview:

  --|   Comments are from GNAT:

  --|     This is a non blocking call. The Process_Id of the spawned process

  --|     is returned. Parameters are to be used as in Spawn. If Invalid_Pid

  --|     is returned the program could not be spawned.

  --|

  --|     Spawning processes from tasking programs is not recommended. See

  --|     "NOTE: Spawn in tasking programs" below.

  -- --

  function GetProcessShutdownParameters

  ( Level : in LPDWORD;

    Flags : in LPDWord

  ) return BOOL;

  function Is_Running

  ( Path : String

    --| Full path of executable

  ) return Boolean;

  --| Return True if executable is currently running

  -- ++

  --| Overview:

  --|   Determine if the executable named by the Path is currently running.

  --

  --| Notes:

  --|   o It is expected that Path will be the full path including the

  --|     trailing ".exe" of the executable.

  --|   o The function iterates through the /proc directory to obtain the

  --|     process identifiers of the running processes and, for each one

  --|     for which ReadLink returns a value for an executable path, it

  --|     compares that value with the supplied Path.  If it matches, True

  --|     is returned.

  -- --

  ---------------------------------------------------------------------------

  --| Notes:                                                                |

  --|   Event types, constants, and functions.                              |

  ---------------------------------------------------------------------------

  procedure Create_Event

  ( Name : in String;

    -- Event name

    Id   : in out Integer;

    --| Event id on input, 0 upon output for failure

    Addr : in System.Address

    --| Address of handle

  );

  function Reset_Event                            -- winbase.h:1878

  ( Event : HANDLE

  ) return Boolean;

  function Set_Event                              -- winbase.h:1871

  ( Event : HANDLE

  ) return Boolean;

  ---------------------------------------------------------------------------

  --| Notes:                                                                |

  --|   Thread types, constants, and functions.                             |

  ---------------------------------------------------------------------------

  -- The following types are duplicates of those in GNAT g-thread.ads and

  -- those needed to interface directly with Linux C functions.

  type Void_Ptr is access all Integer;

  type Thread_Handle_Type is private;

  type Thread_Id_Type is new Interfaces.C.unsigned_long;

  Null_Thread_Id

  : constant Thread_Id_Type := 0;

  Null_Thread_Handle

  --| Null thread handle value

  : constant Thread_Handle_Type;

  PTHREAD_RWLOCK_SIZE --  pthread_rwlock_t

  -- as taken from /usr/lib/gcc/i686-redhat-linux/4.7.0/adainclude/s-oscons.ads

  -- of Fedora install on removal drive

  : constant := 32;

  PTHREAD_ATTR_SIZE --  pthread_attr_t

  -- as taken from /usr/lib/gcc/i686-redhat-linux/4.7.0/adainclude/s-oscons.ads

  -- of Fedora install on removal drive

  : constant := 36;

  PTHREAD_RWLOCKATTR_SIZE --  pthread_rwlockattr_t

  -- as taken from /usr/lib/gcc/i686-redhat-linux/4.7.0/adainclude/s-oscons.ads

  -- of Fedora install on removal drive

  : constant := 8;

  subtype char_array

  -- as taken from /usr/lib/gcc/i686-redhat-linux/4.7.0/adainclude/s-osinte.ads

  -- of Fedora install on removal drive

  is Interfaces.C.char_array;

  type WSA_CHAR_Array is array(Natural range <>) of aliased CHAR;

  type pthread_attr_t

  -- as taken from /usr/lib/gcc/i686-redhat-linux/4.7.0/adainclude/s-osinte.ads

  -- of Fedora install on removal drive

  --    type pthread_attr_t

  is record

    Data : char_array(1 .. PTHREAD_ATTR_SIZE);

  end record;

  pragma Convention (C, pthread_attr_t);

  for pthread_attr_t'Alignment use Interfaces.C.unsigned_long'Alignment;

  type pthread_rwlock_t is record

  -- as taken from /usr/lib/gcc/i686-redhat-linux/4.7.0/adainclude/s-osinte.ads

  -- of Fedora install on removal drive

    Data : char_array(1 .. PTHREAD_RWLOCK_SIZE);

  end record;

  pragma Convention (C, pthread_rwlock_t);

  for pthread_rwlock_t'Alignment use Interfaces.C.unsigned_long'Alignment;

  type pthread_rwlockattr_t is record

  -- as taken from /usr/lib/gcc/i686-redhat-linux/4.7.0/adainclude/s-osinte.ads

  -- of Fedora install on removal drive

    Data : char_array(1 .. PTHREAD_RWLOCKATTR_SIZE);

  end record;

  pragma Convention (C, pthread_rwlockattr_t);

  for pthread_rwlockattr_t'Alignment

    use Interfaces.C.unsigned_long'Alignment;

  subtype Thread_RWLock_Type is pthread_rwlock_t;

  subtype Thread_RWLock_Attr_Type is pthread_rwlockattr_t;

  subtype Thread_Address_Type

  --| System address of a thread

  is System.Address;

  Null_Thread_Address

  --| Null system address for thread

  : constant Thread_Address_Type;

  procedure Create_Thread

  ( Start           : System.Address;  -- pointer to start address of thread

    Parameter       : System.Address;  -- pointer to parameters

    Stack_Size      : Natural;         -- stack size in bytes

    Thread_Priority : Integer;         -- priority for thread

    Thread_Handle   : out Thread_Handle_Type

  );

  -- Creates a thread with the given (Size) stack size in bytes, and

  -- the given (Prio) priority. The task will execute a call to the

  -- procedure whose address is given by Code. This procedure has

  -- the prototype

  --

  --   void thread_code (void *id, void *parm);

  --

  -- where id is the id of the created task, and parm is the parameter

  -- passed to Create_Thread. The called procedure is the body of the

  -- code for the task, the task will be automatically terminated when

  -- the procedure returns.

  --

  -- This function returns the Ada Id of the created task that can then be

  -- used as a parameter to the procedures below.

  --

  -- C declaration:

  --

  -- extern void *__gnat_create_thread

  --   (void (*code)(void *, void *), void *parm, int size, int prio);

  --|

  --| Notes:

  --|   This Create_Thread using GNAT.Threads.  The Thread_Handle that is

  --|   returned is different from that of the C pthread_create Create_Thread

  --|   below.  It needs the use of Get_Thread to return the Thread_Handle

  --|   to a Linux Thread_Id.  Also, when the thread starts the pointer that

  --|   is supposed to be the address of the parameters passed to the thread

  --|   has a different value than that supplied to Create_Thread.

  function Create_Thread

  ( Start      : in System.Address;  -- pointer

    Parameters : in Void_Ptr;        -- pointer

    Stack_Size : in Natural;         -- int

    Priority   : in Integer          -- int

  ) return HANDLE;

  --| Create Thread

  -- ++

  --| Overview:

  --|   This function creates a thread with the given stack size in bytes,

  --|   and the given Priority.  The task will execute a call to the

  --|   procedure whose address is given by Start and may pass the Parameters

  --|   at the address.  The thread handle is at the returned address.

  -- --

  procedure Create_Thread_Linux

  ( Stack_Size    : in Integer;

    --| Stack size to use

    Start         : in System.Address;

    --| Pointer to start address for thread

    Thread_Number : in  Integer;

    --| Application-defined thread number

    Thread_Id     : out Integer;

    --| Identifier returned by pthread_create

    Success       : out Boolean

    --| Whether create was successful

  );

  --| Create Thread

  -- ++

  --| Overview:

  --|   Create thread and return its id at the location specified and True if

  --|   created successfully.

  -- --

  procedure Get_Thread -- get thread identifier from handle

  ( Thread_Handle : in HANDLE;

    Thread_Id     : out PId_t );

  -- This procedure is used to retrieve the thread id of a given task.

  -- The value Thread_Handle is the value that was passed to the thread

  -- code procedure at activation time.

  -- Thread_Id is obtained by this procedure.

  procedure Get_Thread

  ( Thread_Handle : in Thread_Handle_Type;

    --| GNAT thread id

    Thread_Id     : out Thread_Id_Type

    --| Linux thread id

  );

  -- Convert GNAT thread identifier to that of Linux.

  function To_Task_Id

  ( Thread_Handle : in Thread_Handle_Type

  ) return Ada.Task_Identification.Task_Id;

   --  Ada interface only.

  -- Given a low level Id, as returned by Create_Thread, return a Task_Id,

  -- so that operations in Ada.Task_Identification can be used.

  procedure Destroy_Thread

  ( Thread_Handle : Thread_Handle_Type

  );

  -- This procedure may be used to prematurely abort the created thread.

  -- The Thread_Handle is the value that was returned by thread create.

  -- Notes:

  --   There are two sets of procedures/functions.  One using the GNAT

  --   thread identifier that I refer to as the Thread Handle and one

  --   using the Linux C functions that I refer to as the Thread Id.

  --   Matching routines need to be used that use either the handle or

  --   the identifier and not the wrong one for the routine.

  function GetCurrentThreadId

  return Thread_Id_Type;

  -- This function gets the system identifier of the currently running thread.

  function GetCurrentThread                      -- winbase.h:1623

  return HANDLE;

  type Thread_RWLock_Ptr_Type

  is access Thread_RWLock_Type;

  type Thread_RWLock_Attr_Ptr_Type

  is access Thread_RWLock_Attr_Type;

  function Thread_Lock_Init

  ( Lock : Thread_RWLock_Ptr_Type;

    Attr : Thread_RWLock_Attr_Ptr_Type

  ) return Interfaces.C.int;

  -- Initalize thread read/write lock semaphore

  function Thread_Lock_Destroy

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int;

  -- Destroy thread read/write lock semaphore

  pragma Import( C, Thread_Lock_Destroy, "pthread_rwlock_destroy" );

  function Thread_Lock

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int;

  -- Lock the thread read/write lock semaphore

  function Thread_Unlock

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int;

  -- Unlock the thread read/write lock semaphore

  ---------------------------------------------------------------------------

  -- Named pipes

  type mode_t is new Integer;

  subtype Pipe_Handle is File_Handle; --private;

  Invalid_Pipe_Handle

  --|  File descriptor returned when error in opening/creating file;

  : constant Pipe_Handle;

  subtype Pipe_Name_Type

  --| Pipe name

  is String(1..79);

  type Named_Pipe_Name_Type

  --| Name to use for the pipe

  is record

    Count : Integer;

    --| Number of characters in name

    Path  : Pipe_Name_Type;

    --| Path including pipe name

  end record;

  type Open_Mode_Type is new Integer;

  -- see Win32Ada/win32/src/crt/win32-crt-fcntl.ads and

  -- /4.5.4/gcc-include/s-oscons.h of gnat of Linux

  O_RDONLY  : constant Open_Mode_Type := 16#0#;

  O_WRONLY  : constant Open_Mode_Type := 16#1#;

  O_RDWR    : constant Open_Mode_Type := 16#2#;

  -- The above three modes can't be or-ed together.

  O_APPEND  : constant Open_Mode_Type := 16#8#;

  O_CREAT   : constant Open_Mode_Type := 16#100#;

--O_NOCTTY  : constant Open_Mode_Type := 256;  -- 16#100#

  O_NDELAY  : constant Open_Mode_Type := 2048; -- 16#800#

  function MkFifo

  ( Path : System.Address;

    Mode : Mode_t

  ) return Integer;

  function Open

  ( Path : System.Address;

    Mode : Open_Mode_Type

  ) return Pipe_Handle;

  pragma Import( C, Open, "open" );

  function Unlink

  ( Path : System.Address

  ) return Integer;

  pragma Import( C, Unlink, "unlink" );

  subtype PSTR   is PCHAR;                      -- winnt.h

  type    PCCH   is access constant CHAR;       -- winnt.h

  subtype LPCSTR is PCCH;                        -- Win32

  subtype PCSTR  is PCCH;                        -- Win32

  subtype SHORT  is Interfaces.C.Short;          -- winnt.h

  subtype USHORT is Interfaces.C.Unsigned_Short; -- same as Win32

  subtype WORD   is USHORT;                      -- same as Win32

  type    VOID    is null record;                -- same as Win32

  subtype PCVOID  is PVOID;

  subtype LPCVOID is PCVOID;                     -- Win32

  type    PVOID_Array                            -- rpcproxy.h

          is array( Natural range <> ) of aliased PVOID;

  subtype INT    is Interfaces.C.Int;            -- Win32

  subtype UINT   is Interfaces.C.Unsigned;       -- Win32

  type SOCKET is new UINT;                       -- winsock.h:45

  subtype LONG  is Interfaces.C.Long;            -- Win32

  type    PLONG is access all LONG;

  type BY_HANDLE_FILE_INFORMATION;               -- winbase.h:2030

  type LPBY_HANDLE_FILE_INFORMATION              -- winbase.h:2041

  is access all BY_HANDLE_FILE_INFORMATION;

  function to_LPSYSTEMTIME -- convert address to pointer

  is new Unchecked_Conversion( Source => System.Address,

                               Target => LPSystemTime );

  type SECURITY_ATTRIBUTES;                      -- winbase.h:187

  type PSECURITY_ATTRIBUTES is access all SECURITY_ATTRIBUTES; -- winbase.h:191

  subtype LPSECURITY_ATTRIBUTES is PSECURITY_ATTRIBUTES;

  type PHANDLE is access all HANDLE;             -- winnt.h:145

  type LIST_ENTRY;                               -- winnt.h:446

  type PLIST_ENTRY is access all LIST_ENTRY;     -- winnt.h:449

  type RTL_CRITICAL_SECTION;                     -- winnt.h:3953

  type PRTL_CRITICAL_SECTION is access all       -- winnt.h:3977

       RTL_CRITICAL_SECTION;

  type PCRITICAL_SECTION is access all RTL_CRITICAL_SECTION;

  subtype LPCRITICAL_SECTION is PCRITICAL_SECTION; -- winbase.h:231

  type RTL_CRITICAL_SECTION_DEBUG;               -- winnt.h:3950

  type PRTL_CRITICAL_SECTION_DEBUG is access all -- winnt.h:3959

       RTL_CRITICAL_SECTION_DEBUG;

  type SOCKADDR;                                 -- winsock.h:473

  type PSOCKADDR is access all SOCKADDR;         -- winsock.h:830

  type WSADATA;                                  -- winsock.h:328

  type LPWSADATA is access all WSADATA;          -- winsock.h:338

  ---------------------------------------------------------------------------

  --| Notes:  Constants

  ERROR_ALREADY_EXISTS  : constant := 183;        -- winerror.h:1370

  ERROR_IO_PENDING      : constant := 997;        -- winerror.h:1874

  FILE_SHARE_READ       : constant := 16#1#;      -- winnt.h:1848

  FILE_ATTRIBUTE_NORMAL : constant := 16#80#;     -- winnt.h:1855

  GENERIC_READ  : constant := 16#80000000#;       -- winnt.h:1967

  GENERIC_WRITE : constant := 16#40000000#;       -- winnt.h:1968

  STATUS_WAIT_0  : constant DWORD  := 16#0#;      -- winnt.h:702

  STATUS_TIMEOUT : constant DWORD  := 16#102#;    -- winnt.h:705

  WAIT_FAILED   : constant DWORD := 16#ffffffff#; -- winbase.h:66

  WAIT_OBJECT_0 : DWORD renames STATUS_WAIT_0;    -- winbase.h:67

  WAIT_TIMEOUT  : DWORD renames STATUS_TIMEOUT;   -- winbase.h:72

  PIPE_ACCESS_DUPLEX       : constant := 16#3#;   -- winbase.h:133

  CREATE_SUSPENDED              : constant := 16#4#;    -- winbase.h:538

  NORMAL_PRIORITY_CLASS         : constant := 16#20#;   -- winbase.h:544

  IDLE_PRIORITY_CLASS           : constant := 16#40#;   -- winbase.h:545

  HIGH_PRIORITY_CLASS           : constant := 16#80#;   -- winbase.h:546

  REALTIME_PRIORITY_CLASS       : constant := 16#100#;  -- winbase.h:547

  BELOW_NORMAL_PRIORITY_CLASS   : constant := 16#4000#; -- newer windbase.h

  ABOVE_NORMAL_PRIORITY_CLASS   : constant := 16#8000#; -- newer windbase.h

  THREAD_PRIORITY_LOWEST        : constant := -2;       -- winbase.h:557

  THREAD_PRIORITY_BELOW_NORMAL  : constant := -1;       -- winbase.h:558

  THREAD_PRIORITY_NORMAL        : constant := 0;        -- winbase.h:559

  THREAD_PRIORITY_HIGHEST       : constant := 2;        -- winbase.h:560

  THREAD_PRIORITY_ABOVE_NORMAL  : constant := 1;        -- winbase.h:561

  THREAD_PRIORITY_ERROR_RETURN  : constant := 16#7fffffff#;

  THREAD_PRIORITY_TIME_CRITICAL : constant := 15;       -- winbase.h:564

  THREAD_PRIORITY_IDLE          : constant := -15;      -- winbase.h:565

  FILE_END      : constant := 2;                  -- winbase.h:62

  CREATE_ALWAYS : constant := 2;                  -- winbase.h:117

  OPEN_EXISTING : constant := 3;                  -- winbase.h:118

  PIPE_WAIT                : constant := 16#0#;   -- winbase.h:146

  PIPE_READMODE_MESSAGE    : constant := 16#2#;   -- winbase.h:149

  PIPE_TYPE_MESSAGE        : constant := 16#4#;   -- winbase.h:151

  PIPE_UNLIMITED_INSTANCES : constant := 255;     -- winbase.h:157

  function To_Handle is new Unchecked_Conversion

                            ( Source => Integer,

                              Target => HANDLE );

  INVALID_HANDLE_VALUE                            -- winbase.h:57

  : constant HANDLE := To_Handle(-1);

  IPPROTO_TCP        : constant := 6;             -- winsock.h:202

  WSADESCRIPTION_LEN : constant := 256;           -- winsock.h:325

  WSASYS_STATUS_LEN  : constant := 128;           -- winsock.h:326

  SOCK_STREAM        : constant := 1;             -- winsock.h:377

  AF_INET            : constant := 2;             -- winsock.h:448

  PF_INET            : constant := 2;             -- winsock.h:492

  INVALID_SOCKET     : constant := UINT'Last;

  ---------------------------------------------------------------------------

  --| Notes: Unchecked Conversion functions

  ---------------------------------------------------------------------------

  --| Notes: Ada functions to access C functions

  type LPTHREAD_START_ROUTINE is access function

  return DWORD;

  pragma Convention( Stdcall, LPTHREAD_START_ROUTINE ); -- winbase.h:227

  type PHANDLER_ROUTINE is access function           -- same as Win32.Wincon

  ( CtrlType : DWORD

  ) return BOOL;

  pragma Convention( Stdcall, PHANDLER_ROUTINE );

  function to_PHandler -- convert one access type to the other

  is new Unchecked_Conversion( Source => System.Address,

                               Target => PHandler_Routine );

  function Bind                                  -- winsock.h:705

  --| Bind WinSock server socket

  ( S       : SOCKET;

    Addr    : PSOCKADDR; --ac_SOCKADDR_t;

    Namelen : INT

  ) return INT;

  pragma Import( Stdcall, bind, "bind" );        -- winsock.h:705

  function C_Accept                              -- winsock.h:702

  --| Accept WinSock connection

  ( S       : SOCKET;

    Addr    : access SOCKADDR;

    Addrlen : access INT

  ) return SOCKET;

  pragma Import( Stdcall, c_accept, "accept" );  -- winsock.h:702

  function CloseSocket                           -- winsock.h:707

  --| Close WinSock Socket

  ( s : SOCKET

  ) return INT;

  pragma Import( Stdcall, closesocket, "closesocket" ); -- winsock.h:707

  function CreateFile                            -- winbase.h:4745

  ( FileName            : LPCSTR;

    DesiredAccess       : DWORD;

    ShareMode           : DWORD;

    SecurityAttributes  : LPSECURITY_ATTRIBUTES;

    CreationDisposition : DWORD;

    FlagsAndAttributes  : DWORD;

    TemplateFile        : HANDLE

  ) return HANDLE;

  function CreateMailslot                        -- winbase.h:2877

  ( Name               : LPCSTR;

    MaxMessageSize     : DWORD;

    ReadTimeout        : DWORD;

    SecurityAttributes : LPSECURITY_ATTRIBUTES

  ) return HANDLE;

  pragma Import( Stdcall, CreateMailslot, "CreateMailslotA" ); -- winbase.h:2877

  -- CreateMailslot and CreateMailslotA are the same function

  function CreateThread                          -- winbase.h:1598

  ( ThreadAttributes : LPSECURITY_ATTRIBUTES;

    StackSize        : DWORD;

    StartAddress     : LPTHREAD_START_ROUTINE;

    Parameter        : LPVOID;

    CreationFlags    : DWORD;

    ThreadId         : LPDWORD

  ) return HANDLE;

  pragma Import( Stdcall, CreateThread, "CreateThread" ); -- winbase.h:1598

  function Connect                               -- winsock.h:709

  --| Connect to WinSock Socket

  ( s       : SOCKET;

    Name    : PSOCKADDR;

    Namelen : INT

  ) return INT;

  pragma Import( Stdcall, connect, "connect" );  -- winsock.h:709

  function ConnectNamedPipe                      -- winbase.h:2816

  ( NamedPipe  : HANDLE;

    Overlapped : LPOVERLAPPED

  ) return BOOL;

  function CreateNamedPipe                       -- winbase.h:4987

  ( Name               : LPCSTR;

    OpenMode           : DWORD;

    PipeMode           : DWORD;

    MaxInstances       : DWORD;

    OutBufferSize      : DWORD;

    InBufferSize       : DWORD;

    DefaultTimeOut     : DWORD;

    SecurityAttributes : LPSECURITY_ATTRIBUTES

  ) return HANDLE;

  function DisconnectNamedPipe                   -- winbase.h:2824

  ( NamedPipe : HANDLE

  ) return BOOL;

  procedure EnterCriticalSection                 -- winbase.h:1850

  ( CriticalSection : LPCRITICAL_SECTION );

  procedure ExitProcess                          -- winbase.h:1500

  ( ExitCode : UINT );

  MaxArguments: constant := 50;                  -- stdarg.ads

  -- "&" and Concat functions raise Constraint_Error if more than

  -- MaxArguments integer paramters are catenated.

  -- If you change this, change it in var.c also.

  type ArgList is private;                       -- stdarg.ads

  -- An empty arglist, to be used in constructors:

  function Empty return ArgList;                 -- stdarg.ads

  subtype C_Param is Interfaces.C.Long;          -- stdarg.ads

  type Param_Access is private;                  -- stdarg-impl.ads

  function Address_of_First_Arg (Args: ArgList) return Param_Access;

  function FormatMessage                         -- winbase.h:2767

  ( Flags      : DWORD;

    Source     : LPCVOID;

    MessageId  : DWORD;

    LanguageId : DWORD;

    Buffer     : LPSTR;

    Size       : DWORD;

    Arguments  : ArgList := Empty

  ) return DWORD;

  function GetCurrentProcess                     -- winbase.h:1486

  return HANDLE;

  function GetCurrentProcessId                   -- winbase.h:1493

  return DWORD;

  function GetExitCodeProcess                    -- winbase.h:1515

  ( Process  : HANDLE;

    ExitCode : LPDWORD

  ) return BOOL;

  function GetExitCodeThread                     -- winbase.h:1686

  ( Thread   : HANDLE;

    ExitCode : LPDWORD

  ) return BOOL;

  function GetFileInformationByHandle            -- winbase.h:2046

  ( File            : HANDLE;

    FileInformation : LPBY_HANDLE_FILE_INFORMATION

  ) return BOOL;

  pragma Import( Stdcall, GetFileInformationByHandle, -- winbase.h:2046

                         "GetFileInformationByHandle" );

  function GetHostname                           -- winsock.h:763

  --| Get hostname for WinSock

  ( Name    : PSTR;

    Namelen : INT

  ) return INT;

  pragma Import( Stdcall, gethostname, "gethostname" ); -- winsock.h:763

  procedure GetLocalTime                         -- winbase.h:2627

  ( SystemTime : LPSYSTEMTIME

  );

  function GetPriorityClass                      -- winbase.h:6260

  ( Process : HANDLE

  ) return DWORD;

  function GetThreadPriority                     -- winbase.h:1653

  ( Thread : HANDLE

  ) return INT;

  function htons                                 -- winsock.h:724

  ( Hostshort : USHORT

  ) return USHORT;

  pragma Import( Stdcall, htons, "htons" );      -- winsock.h:724

  function inet_addr                             -- winsock.h:726

  ( Cp : PCSTR

  ) return ULONG;

  pragma Import( Stdcall, inet_addr, "inet_addr" ); -- winsock.h:726

  procedure InitializeCriticalSection               -- winbase.h:1843

  ( CriticalSection : LPCRITICAL_SECTION );

  procedure LeaveCriticalSection                 -- winbase.h:1857

  ( CriticalSection : LPCRITICAL_SECTION );

  function Listen                                -- winsock.h:730

  --| Mark the WinSock socket so it will listen for incoming connections

  ( S       : SOCKET;

    Backlog : INT

  ) return INT;

  pragma Import( Stdcall, listen, "listen" );    -- winsock.h:730

  function Recv                                  -- winsock.h:736

  --| Receive from WinSock socket

  ( S     : SOCKET;

    Buf   : PSTR;

    Len   : INT;

    Flags : INT

  ) return INT;

  pragma Import( Stdcall, recv, "recv" );        -- winsock.h:736

  function ResumeThread                          -- winbase.h:1805

  ( Thread : HANDLE

  ) return DWORD;

  pragma Import( Stdcall, ResumeThread, "ResumeThread" ); -- winbase.h:1805

  function Send                                  -- winsock.h:744

  --| Transmit via WinSock socket

  ( S     : SOCKET;

    Buf   : PCSTR;

    Len   : INT;

    Flags : INT

  ) return INT;

  pragma Import( Stdcall, send, "send" );        -- winsock.h:744

  function SetConsoleCtrlHandler                 -- same as Win32.Wincon

  ( HandlerRoutine : PHANDLER_ROUTINE;

    Add            : BOOL

  ) return BOOL;

  function SetFilePointer                        -- winbase.h:2134

  ( File               : HANDLE;

    DistanceToMove     : LONG;

    DistanceToMoveHigh : PLONG;

    MoveMethod         : DWORD

  ) return DWORD;

  pragma Import( Stdcall, SetFilePointer, "SetFilePointer" ); -- winbase.h:2134

  function SetPriorityClass                      -- winbase.h:6252

  ( Process       : HANDLE;

    PriorityClass : DWORD

  ) return BOOL;

  function SetThreadPriority                     -- winbase.h:1645

  ( Thread   : HANDLE;

    Priority : INT

  ) return Boolean; --BOOL;

  function Socket_Func                           -- winsock.h:754

  ( Af       : INT;

    C_Type   : INT;

    Protocol : INT

  ) return SOCKET;

  pragma Import( Stdcall, socket_func, "socket" ); -- winsock.h:754

  function SystemTimeToFileTime                  -- winbase.h:2685

  ( SystemTime : PSYSTEMTIME;

    FileTime   : LPFILETIME

  ) return BOOL;

  pragma Import( Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime"); -- winbase.h:2685

  function TerminateThread                       -- winbase.h:1678

  ( Thread   : HANDLE;

    ExitCode : DWORD

  ) return BOOL;

  function WaitForSingleObject                   -- winbase.h:1908

  ( ObjectHandle : HANDLE;

    Milliseconds : DWORD

  ) return DWORD;

  function WriteFile                             -- winbase.h:2084

  ( File                 : HANDLE;

    Buffer               : LPCVOID;

    NumberOfBytesToWrite : DWORD;

    NumberOfBytesWritten : LPDWORD;

    Overlapped           : LPOVERLAPPED

  ) return BOOL;

  function WSACleanup return INT;                   -- winsock.h:778

  pragma Import( Stdcall, WSACleanup, "WSACleanup" ); -- winsock.h:778

  function WSAGetLastError return INT;           -- winsock.h:782

  pragma Import( Stdcall, WSAGetLastError, "WSAGetLastError" ); -- winsock.h:782

  function WSAStartup                            -- winsock.h:776

  ( VersionRequired : WORD;

    WSAData         : LPWSADATA

  ) return INT;

  pragma Import( Stdcall, WSAStartup, "WSAStartup" ); -- winsock.h:776

  ---------------------------------------------------------------------------

  --| Notes: Structures

  type FILETIME                                  -- winbase.h:204

  is record

    LowDateTime  : DWORD;

    HighDateTime : DWORD;

  end record;

  type BY_HANDLE_FILE_INFORMATION                -- winbase.h:2030

  is record

    FileAttributes     : DWORD;

    CreationTime       : FILETIME;

    LastAccessTime     : FILETIME;

    LastWriteTime      : FILETIME;

    VolumeSerialNumber : DWORD;

    FileSizeHigh       : DWORD;

    FileSizeLow        : DWORD;

    NumberOfLinks      : DWORD;

    FileIndexHigh      : DWORD;

    FileIndexLow       : DWORD;

  end record;

  type LIST_ENTRY                                -- winnt.h:446

  is record

    Flink: PLIST_ENTRY;

    Blink: PLIST_ENTRY;

  end record;

  type OVERLAPPED                                -- winbase.h:179

  is record

    Internal     : DWORD;

    InternalHigh : DWORD;

    Offset       : DWORD;

    OffsetHigh   : DWORD;

    Event        : HANDLE;

  end record;

  type RTL_CRITICAL_SECTION                      -- winnt.h:3953

  is record

    DebugInfo     : PRTL_CRITICAL_SECTION_DEBUG;

    LockCount     : LONG;

    RecursionCount: LONG;

    OwningThread  : HANDLE;

    LockSemaphore : HANDLE;

    Reserved      : DWORD;

  end record;

  type RTL_CRITICAL_SECTION_DEBUG                -- winnt.h:3950

  is record

    C_Type               : WORD;

    CreatorBackTraceIndex: WORD;

    CriticalSection      : PRTL_CRITICAL_SECTION;

    ProcessLocksList     : LIST_ENTRY;

    EntryCount           : DWORD;

    ContentionCount      : DWORD;

    Depth                : DWORD;

    OwnerBackTrace       : PVOID_Array(0..4);

  end record;

  type SECURITY_ATTRIBUTES                       -- winbase.h:187

  is record

    Length             : DWORD;

    SecurityDescriptor : LPVOID;

    InheritHandle      : BOOL;

  end record;

  type SOCKADDR                                  -- winsock.h:473

  is record

    Family : USHORT;

    Data   : WSA_CHAR_Array(0..13);

  end record;

  type SYSTEMTIME1                               -- same as Winbase SYSTEMTIME

  is record

    Year        : WORD;

    Month       : WORD;

    DayOfWeek   : WORD;

    Day         : WORD;

    Hour        : WORD;

    Minute      : WORD;

    Second      : WORD;

    Milliseconds: WORD;

  end record;

  type WSADATA                                   -- winsock.h:328

  is record

    Version      : WORD;

    HighVersion  : WORD;

    Description  : WSA_CHAR_Array(0..WSADESCRIPTION_LEN);

    SystemStatus : WSA_CHAR_Array(0..WSASYS_STATUS_LEN);

    MaxSockets   : USHORT;

    MaxUdpDg     : USHORT;

    VendorInfo   : PSTR;

  end record;

private

  type File_Handle is new Integer;

  function to_File_Handle -- convert integer to file handle

  is new Unchecked_Conversion( Source => Integer,

                               Target => File_Handle );

  Invalid_File_Handle : constant File_Handle := to_File_Handle(-1);

  Invalid_Pipe_Handle : constant Pipe_Handle := Invalid_File_Handle;

  -- The following type is similar to that in s-osinte.ads of GNAT rts native

  -- for a system thread id

  type Thread_Handle_Type is new Interfaces.C.unsigned_long;

  Null_Thread_Handle

  : constant Thread_Handle_Type

  := 0;

  type PId_t is new Integer;

  Invalid_PId : constant PId_t := -1;

  Null_Thread_Address

  --| Null system address for thread

  : constant Thread_Address_Type := Thread_Address_Type(System.Null_Address);

  type ArgVector is array(Integer range <>) of aliased C_Param; -- stdarg.ads

  type ArgBlock is record                     -- stdarg.ads

    Vector      : ArgVector(1..MaxArguments) := (others => 0);

    RefCount    : Natural := 1;

    CurrentArgs : Natural := 0;

    FirstHole   : Natural := 0;

  end record;

  AS: constant := MaxArguments*C_Param'Size; -- stdarg.ads

  NS: constant := Natural'Size;              -- stdarg.ads

  -- On HP target this record must be aligned at mod 8, like a double.

  -- Maybe on Alpha too, not sure.

  -- On other targets the 8 could be changed to 4.

  -- For i386/NT 4 is the size to use

  for ArgBlock use record at mod 4;         -- stdarg.ads

    Vector      at 0        range 0..AS-1;

    RefCount    at AS       range 0..NS-1;

    CurrentArgs at AS+NS    range 0..NS-1;

    FirstHole   at AS+NS+NS range 0..NS-1;

  end record;

  type ArgBlockP is access ArgBlock;       -- stdarg.ads

  type ArgList is                          -- stdarg.ads

    new Ada.Finalization.Controlled with

    record

      Contents: ArgBlockP;

  end record;

  package Arith is new Interfaces.C.Pointers( -- stdarg-impl.ads

                         Integer, C_Param, ArgVector, 0);

  type Param_Access is new Arith.Pointer;     -- stdarg-impl.ads

  pragma Convention( C, BY_HANDLE_FILE_INFORMATION ); -- winbase.h:2030

  pragma Convention( C, FILETIME );                   -- winbase.h:204

  pragma Convention( C, LIST_ENTRY );                 -- winnt.h:446

  pragma Convention( C, OVERLAPPED );                 -- winbase.h:179

  pragma Convention( C, SECURITY_ATTRIBUTES );        -- winbase.h:187

  pragma Convention( C, RTL_CRITICAL_SECTION );       -- winnt.h:3953

  pragma Convention( C, RTL_CRITICAL_SECTION_DEBUG ); -- winnt.h:3950

  pragma Convention( C, SOCKADDR );                   -- winsock.h:473

  pragma Convention( C, SYSTEMTIME1 );                -- winbase.h:213

  pragma Convention( C, WSADATA );                    -- winsock.h:328

end Exec_Itf;

exec_itf.adb:

Various exec_itf procedures and functions output a "<<< … >>> message so that the user can detect if the wrong routine is being used.  That is, these messages shouldn't appear in the log output.

The Windows version of exec_itf.adb is

with Ada.Directories;

with Console; --<<<debug>>>

with GNAT.OS_Lib;

with GNAT.Sockets.Thin;

with GNAT.Threads;

with Interfaces.C;

with Interfaces.C.Strings;

with Machine;

with Numeric_Conversion;

with String_Tools;

package body Exec_Itf is

-->>> temp

    Length

    --| Length of current directory/folder path

    : Integer := 0;

    Current_Directory : String(1..240);

-->>> temp above

  FALSEint : constant := 0;                          -- windef.h

  TRUEint  : constant := 1;                          -- windef.h

  Linux_Config_File_Name

  : constant Config_File_Name_Var_Type

  := ( Count => 46,

       Value => "/home/clayton/Source/EP/Apps-Configuration.dat              " );

  Windows_Config_File_Name

  : constant Config_File_Name_Var_Type

  := ( Count => 35,                   -- Windows

       Value => "C:\Source\EP\Apps-Configuration.dat                         " );

  function Config_File_Name

  return Config_File_Name_Var_Type is

  begin -- Config_File_Name

    if Op_Sys = Linux then

      return Linux_Config_File_Name;

    else

      return Windows_Config_File_Name;

    end if;

  end Config_File_Name;

  procedure Set_Op_Sys is

  begin -- Set_Op_Sys

    --| Logic_Step:

    --|   Obtain current folder name.

    Length := Ada.Directories.Current_Directory'Length;

    declare

      Current_Dir

      --| Path name sized to that to be returned

      : String(1..Length);

    begin

      Current_Dir := Ada.Directories.Current_Directory;

Current_Directory := ( others => ' ' );

Current_Directory(1..Length) := Current_Dir;

      --| Logic_Step:

      --|   Determine operating system that running under from the name.

      if Length > 2 and then

         ( Current_Dir(1..2) = "C:" or else Current_Dir(1..2) = "c:" )

      then

        Op_Sys := Exec_Itf.Windows;

console.write("Set_Op_Sys is Windows");

      elsif Length > 6 and then

            ( Current_Dir(1..6) = "/home/" or else Current_Dir(1..6) = "\home\" )

      then

        Op_Sys := Exec_Itf.Linux;

console.write("Set_Op_Sys is Linux");

      end if;

    end;

  end Set_Op_Sys;

  function GetHostName

  ( Name   : in System.Address;

    Length : in Interfaces.C.int --Computer_Name_Type'last

  ) return Interfaces.C.int; --Interfaces.C.int;

  -- Return host name

  pragma Import(C, GetHostName, "gethostname");

  function GetComputerName

  ( Name   : in System.Address;

    Length : in Computer_Name_Type

  ) return Integer is

    ErrorCode : Interfaces.C.int;

    HostName : String(1..Computer_Name_Type'last);

    for HostName use at Name;

    Result : Integer;

  begin -- GetComputerName

console.write_error("GetComputerName");

    if Op_Sys = Linux then

      ErrorCode := GetHostName( Name   => Name,

                                Length => Interfaces.C.int(Length) );

    else

      ErrorCode := GNAT.Sockets.Thin.C_Gethostname( Name    => Name,

                                                    NameLen => Interfaces.C.int(Length) );

    end if;

    Result := Integer(ErrorCode);

    if Result = 0 then -- no error

      Result := Computer_Name_Type'last;

      for I in 1..Computer_Name_Type'last loop

        if HostName(I) = ASCII.NUL then -- trailing NUL found

          Result := I-1; -- return length of name

          exit; -- loop

        end if;

      end loop;

console.write(HostName(1..Result),Result);

    end if;

    return Result; -- return -1 for error or # of chars in name

  end GetComputerName;

  procedure Exit_to_OS

  ( Status : Integer := 0

  ) is

  begin -- Exit_to_OS

    GNAT.OS_Lib.OS_Exit( Status );

  end Exit_to_OS;

  function Errno return Integer;

  -- Return the task-safe last error number

  pragma Import (C, Errno, "__get_errno");

  function GetLastErrorWindows return DWORD;            -- winbase.h:1703

  pragma Import( Stdcall, GetLastErrorWindows, "GetLastError" ); -- winbase.h:1703

--<<< not for Linux >>>

  function GetLastError

  return Integer is

    LastError : DWORD;

  begin -- GetLastError

    if Op_Sys = Linux then

      return Errno;

    else

      LastError := GetLastErrorWindows;

      return Integer(LastError);

--      return 0; -- can't use above in Linux build

    end if;

  end GetLastError;

  procedure Set_Errno

  ( Errno : Integer );

  -- Set last error number

  pragma Import (C, Set_Errno, "__set_errno");

  type String255 is new String(1..255);

  type StrPtr is access String255;

  -- error messages are no longer than 255 characters

  function StrError

  ( Error_Number : Integer

  ) return StrPtr;

  pragma Import( C, StrError, "strerror" );

  procedure Log_Error is

    Error_Num

    : Integer;

    Error_Ptr

    : Exec_Itf.StrPtr;

  begin -- Log_Error

    Error_Num := Errno; -- get last error number

    if Error_Num = 4 then --EINTR

    end if;

    Error_Ptr := StrError( Error_Number => Error_Num );

    declare

      Length : Integer := 0;

      function to_Addr is new Unchecked_Conversion( Source => StrPtr,

                                                    Target => System.Address );

      Error_Msg : String255;                   -- overlay Ada string on

      for Error_Msg use at to_Addr(Error_Ptr); --  error text

      Err_No : Numeric_Conversion.String_Type;

      Err : String(1..255) := ( others => ASCII.NUL );

      Msg : String(1..10+255);

    begin

      -- Copy error text at StrPtr while ignoring following text

      for I in 1..255 loop

        exit when Error_Msg(I) = ASCII.NUL;

        Err(I) := Error_Msg(I);

        Length := I;

      end loop;

      Msg(1..6) := "Error ";

      Err_No := Numeric_Conversion.Integer_to_ASCII(Error_Num,3);

      Msg(7..Err_No.Length+6) := Err_No.Value(1..Err_No.Length); -- ASCII value

      for I in Err_No.Length+7..10 loop -- insert following space(s)

        Msg(I) := ' ';

      end loop;

      Msg(11..Length+10) := Err(1..Length); -- copy error text

      Console.Write( Msg(1..Length+10) );

    end;

    --| Logic_Step:

    --|   Clear the last reported error so the next time this routine is

    --|   called, any last error will be different from this one.

    Set_Errno(0);

  end Log_Error;

  -- **********************************************************

  -- This package describes the differences in machine

  -- architectures that need to be known by Stdarg.

  --

  -- I386 is Intel 386/486/Pentium PC's

  -- Sparc is Sun-4 Sparcstation and Sparcserver

  -- HP is Hewlett-Packard HP-9000 series 700 and 800

  -- Mips is machines based on the MIPS chip, such as SGI

  -- PowerPC is Apple-IBM-Motorola Power PC, and IBM RS/6000

  -- Alpha is the Digital Equipment Corporation chip.

  --

  -- To build these packages for a different architecture,

  -- change the constant This_Arch to one of the allowed values

  -- and recompile.

  -- **********************************************************

  type Arch is (I386, Sparc, HP, Mips, Alpha, PowerPC); -- stdarg-machine.ads

  This_Arch: constant Arch := I386;                     -- stdarg-machine.ads

  type Stack_Growth_Direction                           -- stdarg-machine.ads

  is ( Up,             -- toward address 0

       Down );         -- toward high numbered addresses

  type Which_Arg is (Ellipsis, VA_List);  -- Stdarg-impl.adb

  type Arch_Description_Rec

  is record

    Int_Param_Alignment,

    Float_Param_Alignment : Positive;

    Stack_Growth          : Stack_Growth_Direction;

  end record;

  SU : constant := System.Storage_Unit;

  Arch_Description

  : constant array (Arch) of Arch_Description_Rec

  := (  I386 => (

          Int_Param_Alignment   => C_Param'Size/SU,

          Float_Param_Alignment => C_Param'Size/SU,

          Stack_Growth          => Up )

      , Sparc => (

          Int_Param_Alignment   => C_Param'Size/SU,

          Float_Param_Alignment => C_Param'Size/SU,

          Stack_Growth          => Up )

      , HP => (

          Int_Param_Alignment   => C_Param'Size/SU,

          Float_Param_Alignment => Interfaces.C.Double'Size/SU,

          Stack_Growth          => Down )

      , Mips => (

          Int_Param_Alignment   => C_Param'Size/SU,

          Float_Param_Alignment => Interfaces.C.Double'Size/SU,

          Stack_Growth          => Up )

      , Alpha => (

          Int_Param_Alignment   => C_Param'Size/SU,

          Float_Param_Alignment => Interfaces.C.Double'Size/SU,

          Stack_Growth          => Up )

      , PowerPC => (

          Int_Param_Alignment   => C_Param'Size/SU,

          Float_Param_Alignment => C_Param'Size/SU,

          Stack_Growth          => Up )

     );

  Desc                 : Arch_Description_Rec renames    -- stdarg-machine.ads

                     Arch_Description(This_Arch);

  Int_Param_Alignment  : Positive renames Desc.Int_Param_Alignment;        -- stdarg-machine.ads

  Float_Param_Alignment: Positive renames Desc.Float_Param_Alignment;      -- stdarg-machine.ads

  Stack_Growth         : Stack_Growth_Direction renames Desc.Stack_Growth; -- stdarg-machine.ads

  Param_Size           : constant Positive := C_Param'Size/SU;             -- stdarg-machine.ads

  function Address_of_Arg                 -- Stdarg-impl.adb

  ( Args  : ArgList;

    Which : Which_Arg

  ) return Param_Access is

  begin

    if Args.Contents.CurrentArgs = 0 then

      return null; -- might not be an error

    end if;

    if This_Arch = Alpha then

      return Args.Contents.Vector(7)'access;

    elsif Stack_Growth = Up then

      return Args.Contents.Vector(1)'access;

    elsif Which = Ellipsis then

      return Args.Contents.Vector(MaxArguments-Args.Contents.CurrentArgs+1)'access;

    else

      declare

      use Arith;

      P : Pointer := Args.Contents.Vector(MaxArguments)'access;

      begin

        return Param_Access(P+1);

      end;

   end if;

  end Address_of_Arg;

  function Address_of_First_Arg      -- Stdarg-impl.adb

  ( Args : ArgList

  ) return Param_Access is

  begin

    return Address_of_Arg(Args, Ellipsis);

  end Address_of_First_Arg;

  function Empty return ArgList is    -- Stdarg.adb

    Res: ArgList;

  begin

    Res.Contents := new ArgBlock;

    -- Res.Contents.RefCount := 2;                         -- GNAT bug

    return Res;

  end Empty;

  function FormatMessage -- only for Windows

  ( Flags      : DWORD;

    Source     : LPCVOID;

    MessageId  : DWORD;

    LanguageId : DWORD;

    Buffer     : LPSTR;

    Size       : DWORD;

    Arguments  : ArgList := Empty

  ) return DWORD is

    function Doit    --<<< can't use with Linux >>>

    ( dwFlags      : DWORD;

      lpSource     : LPCVOID;

      dwMessageId  : DWORD;

      dwLanguageId : DWORD;

      lpBuffer     : LPSTR;

      nSize        : DWORD;

      Arguments    : access Param_Access --Stdarg.Impl.Param_Access

    ) return DWORD;

    pragma Import( Stdcall, Doit, "FormatMessageA" );

--<<< not for Linux >>>

    Param_Addr

    : aliased Param_Access

    := Address_of_First_Arg(Arguments);

  begin

    if Op_Sys = Linux then

      Console.Write_Error("<<<FormatMessage Linux entered>>>");

      return Falseint;

    else

      return Doit( Flags, Source, MessageId, LanguageId,

                   Buffer, Size, Param_Addr'access );    -- strange

    end if;

  end FormatMessage;

--<<< not for Linux >>>

  function SetConsoleCtrlHandlerWindows            -- same as Win32.Wincon

  ( HandlerRoutine : PHANDLER_ROUTINE;

    Add            : BOOL

  ) return BOOL;

  pragma Import( Stdcall, SetConsoleCtrlHandlerWindows, "SetConsoleCtrlHandler" ); -- wincon.h:571

  function SetConsoleCtrlHandler                 -- same as Win32.Wincon

  ( HandlerRoutine : PHANDLER_ROUTINE;

    Add            : BOOL

  ) return BOOL is

  begin

    if Op_Sys = Linux then

      Console.Write_Error("<<<SetConsoleCtrlHandler Linux entered>>>");

      return Falseint;

    else

      return SetConsoleCtrlHandlerWindows( HandlerRoutine => HandlerRoutine,

                                           Add            => Add );

    end if;

  end SetConsoleCtrlHandler;

--<<< not for Linux >>>

  procedure InitializeCriticalSectionWindows                 -- winbase.h:1843

  ( CriticalSection : LPCRITICAL_SECTION

  );

  pragma Import( Stdcall, InitializeCriticalSectionWindows,  -- winbase.h:1843

                         "InitializeCriticalSection");

  procedure InitializeCriticalSection                 -- winbase.h:1843

  ( CriticalSection : LPCRITICAL_SECTION

  ) is

  begin -- InitializeCriticalSection

    if Op_Sys = Linux then

      console.Write_Error("<<<InitializeCriticalSection Linux entered>>>");

    else

      InitializeCriticalSectionWindows( CriticalSection => CriticalSection );

    end if;

  end InitializeCriticalSection;

--<<< not for Linux >>>

  procedure LeaveCriticalSectionWindows                 -- winbase.h:1857

  ( CriticalSection : LPCRITICAL_SECTION

  );

  pragma Import( Stdcall, LeaveCriticalSectionWindows,  -- winbase.h:1857

                         "LeaveCriticalSection" );

  procedure LeaveCriticalSection                 -- winbase.h:1857

  ( CriticalSection : LPCRITICAL_SECTION

  ) is

  begin -- LeaveCriticalSection

    if Op_Sys = Linux then

      Console.Write_Error("<<<LeaveCriticalSection Linux entered>>>");

    else

      LeaveCriticalSectionWindows( CriticalSection => CriticalSection );

    end if;

  end LeaveCriticalSection;

  ---------------------------------------------------------------------------

  -- Directories

  type Dir_Entity_Struct_Type

  --| Linux note:

  --|  The only fields in the dirent structure that are mandated by POSIX.1 are:

  --|  o d_name[], of unspecified size, with at most NAME_MAX characters

  --|              preceding the terminating null byte; and

  --|  o (as an XSI extension) d_ino.

  --|  The other fields are unstandardized, and not present on all systems.

  is record

    D_INo    : Machine.Unsigned_Longword; -- File system i-node number

    -- The file serial number, which distinguishes this file from all other

    -- files on the same device.

    D_Off    : Machine.Unsigned_Longword; -- i.e., of type off_t

    -- File offset, measured in bytes from the beginning of a file or device.

    -- off_t is normally defined as a signed, 32-bit integer. In the

    -- programming environment which enables large files, off_t is defined

    -- to be a signed, 64-bit integer.

    D_Reclen : Machine.Unsigned_Word;

    D_Type   : Machine.Unsigned_Byte;

    D_Name   : String(1..256); -- null terminated

  end record;

  type Dir_Entity_Ptr_Type is access Dir_Entity_Struct_Type;

  function OpenDir

  ( File_Name : String

    --| Name of directory; null terminated

  ) return System.Address;

  --| Pointer to opened directory

  pragma Import (C, OpenDir, "__gnat_opendir");

  function ReadDir

  ( Directory : System.Address

    --| Pointer to opened directory

  ) return Dir_Entity_Ptr_Type;

  --| Return pointer to directory entity

  pragma Import( C, ReadDir, "readdir" );

  function ReadLink

  ( Proc   : System.Address;

    --| Pointer to null terminated string

    Buffer : System.Address;

    --| Pointer to buffer for path

    Length : Integer

    --| Length of buffer

  ) return Integer;

  --| Return number of characters output to Buffer

--  pragma Import( C, ReadLink, "readlink" );

-- needed for Linux

  function ReadLink

  ( Proc   : System.Address;

    --| Pointer to null terminated string

    Buffer : System.Address;

    --| Pointer to buffer for path

    Length : Integer

    --| Length of buffer

  ) return Integer is

  begin -- ReadLink

Console.Write_Error("<<< ReadLink entered >>>");

    return -1;

  end ReadLink;

--above to compile for Windows

  ---------------------------------------------------------------------------

  -- Files

  function File_Descriptor_to_Handle

  is new Unchecked_Conversion( Source => GNAT.OS_Lib.File_Descriptor,

                               Target => File_Handle );

  function Handle_to_File_Descriptor

  is new Unchecked_Conversion( Source => File_Handle,

                               Target => GNAT.OS_Lib.File_Descriptor );

  function to_Mode is new Unchecked_Conversion( Source => Mode_Type,

                                                Target => GNAT.OS_Lib.Mode );

  function Close_File

  ( Handle : File_Handle

  ) return Boolean is

    Status : Boolean;

  begin -- Close_File

    GNAT.OS_Lib.Close( FD     => Handle_to_File_Descriptor(Handle),

                       Status => Status );

    return Status;

  end Close_File;

  function Create_File

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle is

  -- Creates new file with given name for writing, returning the file

  -- descriptor for subsequent use in Write calls. The file descriptor

  -- returned is Invalid_File_Handle if file cannot be successfully created

    FileDesc : GNAT.OS_Lib.File_Descriptor;

    function File_Descriptor_to_Handle

    is new Unchecked_Conversion( Source => GNAT.OS_Lib.File_Descriptor,

                                 Target => File_Handle );

    function to_Mode is new Unchecked_Conversion( Source => Mode_Type,

                                                  Target => GNAT.OS_Lib.Mode );

  begin -- Create_File

    FileDesc := GNAT.OS_Lib.Create_File( Name  => Name'address,

                                         FMode => to_Mode(Mode) );

    return File_Descriptor_to_Handle( FileDesc );

  end Create_File;

  function Create_New_File

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle is

  -- Create new file with given name for writing, returning file descriptor

  -- for subsequent use in Write calls. This differs from Create_File in

  -- that it fails if the file already exists. File descriptor returned is

  -- Invalid_FD if the file exists or cannot be created.

    FileDesc : GNAT.OS_Lib.File_Descriptor;

  begin -- Create_New_File

    FileDesc := GNAT.OS_Lib.Create_New_File( Name  => Name,

                                             FMode => to_Mode(Mode) );

    return File_Descriptor_to_Handle( FileDesc );

  end Create_New_File;

  function Open_Read

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle is

    FileDesc : GNAT.OS_Lib.File_Descriptor;

    function File_Descriptor_to_Handle

    is new Unchecked_Conversion( Source => GNAT.OS_Lib.File_Descriptor,

                                 Target => File_Handle );

    function to_Mode is new Unchecked_Conversion( Source => Mode_Type,

                                                  Target => GNAT.OS_Lib.Mode );

  begin -- Open_Read

    FileDesc := GNAT.OS_Lib.Open_Read( Name  => Name'address,

                                       FMode => to_Mode(Mode) );

    return File_Descriptor_to_Handle( FileDesc );

  end Open_Read;

  function Open_Read_Write

  ( Name : String;

    Mode : Mode_Type := Text

  ) return File_Handle is

  --  Open file Name for both reading and writing, returning file

  --  descriptor. File descriptor returned is Invalid_FD if file cannot be

  --  opened.

    Handle : GNAT.OS_Lib.File_Descriptor;

  begin -- Open_Read_Write

    Handle := GNAT.OS_Lib.Open_Read_Write( Name  => Name,

                                           FMode => to_Mode(Mode) );

    return File_Descriptor_to_Handle( Handle );

  end Open_Read_Write;

  function Read_File

  ( File : File_Handle;

    Addr : System.Address;

    Num  : Integer

  ) return Integer is

    Bytes_Read : Integer := 0;

  begin -- Read_File

    Bytes_Read := GNAT.OS_Lib.Read( FD => Handle_to_File_Descriptor(File),

                                    A  => Addr, --Bytes'address,

                                    N  => Num );

    return Bytes_Read;

  exception

    when others =>

      Console.Write_Error("exec_itf Read_File exception");

      return 0;

  end Read_File;

  function Write_File

  --| Write Text to File and return number of bytes written.  Strip internal

  --| NULs if True.

  ( File       : in File_Handle;

    Text       : in String;

    Strip_NULs : in Boolean := False

  ) return Integer is

    Index  : Integer := 0;

    Length : Integer;

    Result : Integer;

    Text_Out : String(1..Text'length+1);

  begin -- Write_File

    Length := Text'length;

    Text_Out(1..Length) := Text;

    Text_Out(Length+1)  := ASCII.NUL;

    -- Avoid the output of nulls embedded in the text.

    if Strip_NULs then

      for I in 1..Length loop

        if Text_Out(I) /= ASCII.NUL then

          Index := Index + 1;

          Text_Out(Index) := Text_Out(I);

        end if;

      end loop;

      Length := Index;

      Text_Out(Length+1) := ASCII.NUL;

    end if;

    Result := GNAT.OS_Lib.Write( FD => Handle_to_File_Descriptor(File),

                                 A  => Text_Out'address,

                                 N  => Length );

    return Result;

  end Write_File;

  function Write_File

  --| Write Len bytes at Addr to File and return number of bytes written.

  ( File : File_Handle;

    Addr : System.Address;

    Len  : Integer

  ) return Integer is

    Result : Integer;

  begin -- Write_File

    Result := GNAT.OS_Lib.Write( FD => Handle_to_File_Descriptor(File),

                                 A  => Addr, --Bytes_Out'address,

                                 N  => Len );

    return Result;

  end Write_File;

  ---------------------------------------------------------------------------

  -- Pipes

  function MkFifo_Linux

  ( Path : System.Address;

    Mode : Mode_t

  ) return Integer;

--  pragma Import( C, MkFifo_Linux, "mkfifo" );

-- above for Linux

  function MkFifo_Linux

  ( Path : System.Address;

    Mode : Mode_t

  ) return Integer is

  begin

Console.Write_Error("<<< MkFifo entered >>>");

    return -1;

  end;

--<<< above to compile for Windows >>>

  function MkFifo

  ( Path : System.Address;

    Mode : Mode_t

  ) return Integer is

  begin -- MkFifo

    if Op_Sys = Linux then

      return MkFifo_Linux( Path => Path,

                           Mode => Mode );

    else

      return -1;

    end if;

  end MkFifo;

  function CloseHandleWindows                     -- winbase.h:2171

  ( Object : HANDLE

  ) return BOOL;

--<<< not for Linux >>>

  pragma Import( Stdcall, CloseHandleWindows, "CloseHandle" ); -- winbase.h:2171

  function CloseHandle                           -- winbase.h:2171

  ( Object : HANDLE

  ) return BOOL is

  begin -- CloseHandle

    if Op_Sys = Linux then

      Console.Write_Error("<<<CloseHandle Linux entered>>>");

      return FALSEint;

    else

      return CloseHandleWindows( Object => Object );

    end if;

  end CloseHandle;

  function CreateFileWindows                            -- winbase.h:4745

  ( FileName            : LPCSTR;

    DesiredAccess       : DWORD;

    ShareMode           : DWORD;

    SecurityAttributes  : LPSECURITY_ATTRIBUTES;

    CreationDisposition : DWORD;

    FlagsAndAttributes  : DWORD;

    TemplateFile        : HANDLE

  ) return HANDLE;

  pragma Import( Stdcall, CreateFileWindows, "CreateFileA" ); -- winbase.h:4745

  -- CreateFile and CreateFileA are the same function

--<<< not for Linux >>>

  function CreateFile                            -- winbase.h:4745

  ( FileName            : LPCSTR;

    DesiredAccess       : DWORD;

    ShareMode           : DWORD;

    SecurityAttributes  : LPSECURITY_ATTRIBUTES;

    CreationDisposition : DWORD;

    FlagsAndAttributes  : DWORD;

    TemplateFile        : HANDLE

  ) return HANDLE is

  begin -- CreateFile

    if Op_Sys = Linux then

      Console.Write_Error("<<<CreateFile Linux entered>>>");

      return System.Null_Address;

    else

      return CreateFileWindows( FileName            => FileName,

                                DesiredAccess       => DesiredAccess,

                                ShareMode           => ShareMode,

                                SecurityAttributes  => SecurityAttributes,

                                CreationDisposition => CreationDisposition,

                                FlagsAndAttributes  => FlagsAndAttributes,

                                TemplateFile        => TemplateFile );

    end if;

  end CreateFile;

  function ConnectNamedPipeWindows                      -- winbase.h:2816

  ( NamedPipe  : HANDLE;

    Overlapped : LPOVERLAPPED

  ) return BOOL;

  pragma Import( Stdcall, ConnectNamedPipeWindows, "ConnectNamedPipe" ); -- winbase.h:2816

-- above for Windows

--  function ConnectNamedPipeWindows                      -- winbase.h:2816

--  ( NamedPipe  : HANDLE;

--    Overlapped : LPOVERLAPPED

--  ) return BOOL is

--  begin

--    return FALSEint;

--  end;

--<<< not for Linux >>>

  function ConnectNamedPipe

  ( NamedPipe  : HANDLE;

    Overlapped : LPOVERLAPPED

  ) return BOOL is

  begin -- ConnectNamedPipe

    if Op_Sys = Linux then

console.write_error("<<<ConnectNamedPipe Linux entered>>>");

      return FALSEint;

    else

      return ConnectNamedPipeWindows( NamedPipe  => NamedPipe,

                                      Overlapped => Overlapped );

    end if;

  end ConnectNamedPipe;

  function CreateNamedPipeWindows                       -- winbase.h:4987

  ( Name               : LPCSTR;

    OpenMode           : DWORD;

    PipeMode           : DWORD;

    MaxInstances       : DWORD;

    OutBufferSize      : DWORD;

    InBufferSize       : DWORD;

    DefaultTimeOut     : DWORD;

    SecurityAttributes : LPSECURITY_ATTRIBUTES

  ) return HANDLE;

  pragma Import( Stdcall, CreateNamedPipeWindows, "CreateNamedPipeA" ); -- winbase.h:4987

  -- CreateNamedPipe and CreateNamedPipeA are the same function

--<<< not for Linux >>>

--  function CreateNamedPipeWindows                       -- winbase.h:4987

--  ( Name               : LPCSTR;

--    OpenMode           : DWORD;

--    PipeMode           : DWORD;

--    MaxInstances       : DWORD;

--    OutBufferSize      : DWORD;

--    InBufferSize       : DWORD;

--    DefaultTimeOut     : DWORD;

--    SecurityAttributes : LPSECURITY_ATTRIBUTES

--  ) return HANDLE is

--  begin

--Console.Write_Error("<<<CreateNamedPipeWindows entered>>>");

--    return System.Null_Address;

--  end;

  function CreateNamedPipe

  ( Name               : LPCSTR;

    OpenMode           : DWORD;

    PipeMode           : DWORD;

    MaxInstances       : DWORD;

    OutBufferSize      : DWORD;

    InBufferSize       : DWORD;

    DefaultTimeOut     : DWORD;

    SecurityAttributes : LPSECURITY_ATTRIBUTES

  ) return HANDLE is

  begin -- CreateNamedPipe

    if Op_Sys = Linux then

Console.Write_Error("<<<CreateNamedPipe Linux entered>>>");

      return System.Null_Address;

    else

      return CreateNamedPipeWindows

             ( Name               => Name,

               OpenMode           => OpenMode,

               PipeMode           => PipeMode,

               MaxInstances       => MaxInstances,

               OutBufferSize      => OutBufferSize,

               InBufferSize       => InBufferSize,

               DefaultTimeOut     => DefaultTimeOut,

               SecurityAttributes => SecurityAttributes );

    end if;

  end CreateNamedPipe;

  function DisconnectNamedPipeWindows                   -- winbase.h:2824

  ( NamedPipe : HANDLE

  ) return BOOL;

--<<< not for Linux >>>

  pragma Import( Stdcall, DisconnectNamedPipeWindows, "DisconnectNamedPipe" ); -- winbase.h:2824

  function DisconnectNamedPipe                   -- winbase.h:2824

  ( NamedPipe : HANDLE

  ) return BOOL is

  begin -- DisconnectNamedPipe

    if Op_Sys = Linux then

      Console.Write_Error("<<<DisconnectNamedPipe Linux entered>>>");

      return FALSEint;

    else

      return DisconnectNamedPipeWindows( NamedPipe => NamedPipe );

    end if;

  end DisconnectNamedPipe;

  function ReadFileWindows                              -- winbase.h:2095

  ( File                : HANDLE;

    Buffer              : LPVOID;

    NumberOfBytesToRead : DWORD;

    NumberOfBytesRead   : LPDWORD;

    Overlapped          : LPOVERLAPPED

  ) return BOOL;

--<<< not for Linux >>>

  pragma Import( Stdcall, ReadFileWindows, "ReadFile"); -- winbase.h:2095

  function ReadFile                              -- winbase.h:2095

  ( File                : HANDLE;

    Buffer              : LPVOID;

    NumberOfBytesToRead : DWORD;

    NumberOfBytesRead   : LPDWORD;

    Overlapped          : LPOVERLAPPED

  ) return BOOL is

  begin -- ReadFile

    if Op_Sys = Linux then

      Console.Write_Error("<<<ReadFile Linux entered>>>");

      return FALSEint;

    else

      return ReadFileWindows( File => File,

                             Buffer => Buffer,

                             NumberOfBytesToRead => NumberOfBytesToRead,

                             NumberOfBytesRead   => NumberOfBytesRead,

                             Overlapped          => Overlapped );

    end if;

  end ReadFile;

  function WriteFileWindows                             -- winbase.h:2084

  ( File                 : HANDLE;

    Buffer               : LPCVOID;

    NumberOfBytesToWrite : DWORD;

    NumberOfBytesWritten : LPDWORD;

    Overlapped           : LPOVERLAPPED

  ) return BOOL;

--<<< not for Linux >>>

  pragma Import( Stdcall, WriteFileWindows, "WriteFile" ); -- winbase.h:2084

  function WriteFile                             -- winbase.h:2084

  ( File                 : HANDLE;

    Buffer               : LPCVOID;

    NumberOfBytesToWrite : DWORD;

    NumberOfBytesWritten : LPDWORD;

    Overlapped           : LPOVERLAPPED

  ) return BOOL is

  begin -- WriteFile

    if Op_Sys = Linux then

      Console.Write_Error("<<<WriteFile Linux entered>>>");

      return FALSEint;

    else

      return WriteFileWindows( File                 => File,

                               Buffer               => Buffer,

                               NumberOfBytesToWrite => NumberOfBytesToWrite,

                               NumberOfBytesWritten => NumberOfBytesWritten,

                              Overlapped           => Overlapped );

    end if;

  end WriteFile;

  ---------------------------------------------------------------------------

  -- Events

  function CreateEventWindows                       -- winbase.h:3457

  ( EventAttributes : LPSECURITY_ATTRIBUTES;

    ManualReset     : BOOL;

    InitialState    : BOOL;

    Name            : LPCSTR

  ) return HANDLE;

  pragma Import( Stdcall, CreateEventWindows, "CreateEventA" ); -- winbase.h:3457

-->>> above not for Linux

--  ) return HANDLE is

--  begin

--    return System.Null_Address;

--  end;

--<<< to compile for Linux >>>

  function Pipe    -->> Linux

  ( Handle : System.Address --File_Handle

  ) return Integer;

--pragma Import( C, Pipe, "pipe" );

--needed for Linux

  function Pipe

  ( Handle : System.Address --File_Handle

  ) return Integer is

  begin -- Pipe

console.write_error("<<<Pipe entered>>>");

    return -1;

  end Pipe;

-- only to compile in Windows

  function Thread_Lock_Init_Linux --> Linux

  ( Lock : Thread_RWLock_Ptr_Type;

    Attr : Thread_RWLock_Attr_Ptr_Type

  ) return Interfaces.C.int;

--  pragma Import( C, Thread_Lock_Init_Linux, "pthread_rwlock_init" ); -- needed for Linux

--<<< not for Windows >>>

  function Thread_Lock_Init_Linux --> to compile for Windows

  ( Lock : Thread_RWLock_Ptr_Type;

    Attr : Thread_RWLock_Attr_Ptr_Type

  ) return Interfaces.C.int is

  begin -- Thread_Lock_Init_Linux

    Console.Write_Error("<<<Thread_Lock_Init_Linux entered>>>");

    return Interfaces.C.int(-1);

  end Thread_Lock_Init_Linux;

  function Thread_Lock_Linux --> Linux

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int;

  -- Lock the thread read/write lock semaphore

--  pragma Import( C, Thread_Lock_Linux, "pthread_rwlock_wrlock" );

--<<< not for Windows >>>

  function Thread_Lock_Linux --> to compile for Windows

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int is

  begin -- Thread_Lock_Linux

    Console.Write_Error("<<<Thread_Lock_Linux entered>>>");

    return Interfaces.C.int(-1);

  end Thread_Lock_Linux;

--needed for Linux

  function Thread_Lock_Init --> Linux

  ( Lock : Thread_RWLock_Ptr_Type;

    Attr : Thread_RWLock_Attr_Ptr_Type

  ) return Interfaces.C.int is

  begin

    if Op_Sys = Linux then

--      return Thread_Lock_Init_Linux( Lock => Lock,

--                                     Attr => Attr );

Console.Write_Error("<<<Thread_Lock_Init_Linux entered>>>");

return Interfaces.C.int(-1);

    else -- Windows

      return Interfaces.C.int(-1);

    end if;

  end Thread_Lock_Init;

--needed for Linux

  function Thread_Lock --> Linux

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int is

  begin

    if Op_Sys = Linux then

      --      return Thread_Lock_Linux( Lock => Lock );

Console.Write_Error("<<<Thread_Lock_Linux entered>>>");

      return Interfaces.C.int(-1);

    else -- Windows

      return Interfaces.C.int(-1);

    end if;

  end Thread_Lock;

  function Thread_Unlock_Linux

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int;

  -- Unlock the thread read/write lock semaphore

--  pragma Import( C, Thread_Unlock_Linux, "pthread_rwlock_unlock" );

-- above needed for Linux

  function Thread_Unlock_Linux

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int is

  begin

Console.Write_Error("<<<Thread_Unlock_Linux entered>>>");

    return Interfaces.C.int(-1);

  end Thread_Unlock_Linux;

-- above to compile in Windows

  function Thread_Unlock

  ( Lock : Thread_RWLock_Ptr_Type

  ) return Interfaces.C.int is

  begin

    if Op_Sys = Linux then

      return Thread_Unlock_Linux( Lock => Lock );

    else -- Windows

Console.Write_Error("<<<Thread_Unlock entered>>>");

      return Interfaces.C.int(-1);

    end if;

  end Thread_Unlock;

  procedure Create_Event

  ( Name : in String; --Thread_Event_Name_Type; --LPCSTR;  --<<< change to string

    Id   : in out Integer;  --<<< change to string

    Addr : in System.Address --HANDLE

  ) is

  begin -- Create_Event

    if Exec_Itf.Op_Sys = Exec_Itf.Linux then

      declare

        Result : Integer := -1;

      begin

        Result := Pipe( Addr );

        if Result < 0 then

          Id     := 0;

      --else

      --  Id leave unchanged

      --  Handle leave unchanged

  --      Status   := No_Error;

        end if;

      end;

    else

      declare

        Result : HANDLE := System.Null_Address;

        for Result use at Addr;

        function to_Ptr is new Unchecked_Conversion( Source => System.Address,

                                                    Target => LPCSTR );

        use type System.Address;

      begin

        Result := CreateEventWindows

                  ( EventAttributes => null,

                    ManualReset     => TRUEint,

                    InitialState    => FALSEint,

                    Name            => to_Ptr(Name'address) );

         if Result = System.Null_Address then

          Id := 0;

        end if;

      end;

    end if;

  end Create_Event;

  function ResetEventWindows                  -- winbase.h:1878

  ( Event : HANDLE

  ) return BOOL;

  pragma Import( Stdcall, ResetEventWindows, "ResetEvent" ); -- winbase.h:1878

--<<< not for Linux >>>

  function Reset_Event

  ( Event : HANDLE

  ) return Boolean is

    Result : BOOL := FALSEint;

  begin -- Reset_Event

    if Op_Sys = Linux then

Console.Write_Error("<<<Reset_Event Linux entered>>>");

      return False; -- no such function

    else

      Result := ResetEventWindows( Event => Event );

      return Result /= FALSEint;

    end if;

  end Reset_Event;

  function SetEvent                              -- winbase.h:1871

  ( Event : HANDLE

  ) return BOOL;

  pragma Import( Stdcall, SetEvent, "SetEvent" ); -- winbase.h:1871

--<<< not for Linux >>>

  function WaitForSingleObjectWindows                   -- winbase.h:1908

  ( ObjectHandle : HANDLE;

    Milliseconds : DWORD

  ) return DWORD;

--<<< not for Linux >>>

  pragma Import( Stdcall, WaitForSingleObjectWindows, "WaitForSingleObject" ); -- winbase.h:1908

  function WaitForSingleObject                   -- winbase.h:1908

  ( ObjectHandle : HANDLE;

    Milliseconds : DWORD

  ) return DWORD is

  begin -- WaitForSingleObject

    if Op_Sys = Linux then

Console.Write_Error("<<<WaitForSingleObject Linux entered>>>");

      return 0;

    else

      return WaitForSingleObjectWindows( ObjectHandle => ObjectHandle,

                                        Milliseconds => Milliseconds );

    end if;

  end WaitForSingleObject;

  procedure EnterCriticalSectionWindows                 -- winbase.h:1850

  ( CriticalSection : LPCRITICAL_SECTION );

--<<< not for Linux >>>

  pragma Import( Stdcall, EnterCriticalSectionWindows, "EnterCriticalSection" ); -- winbase.h:1850

  procedure EnterCriticalSection                 -- winbase.h:1850

  ( CriticalSection : LPCRITICAL_SECTION ) is

  begin -- EnterCriticalSection

    if Op_Sys = Linux then

      Console.Write_Error("<<<EnterCriticalSection entered>>>");

    else

      EnterCriticalSectionWindows( CriticalSection => CriticalSection );

    end if;

  end EnterCriticalSection;

  function Set_Event

  ( Event : HANDLE

  ) return Boolean is

  begin -- Set_Event

    if Op_Sys = Linux then

      declare

        Message

        --| One byte "message" to write to pipe

        : constant String(1..1) := ( others => 'e' );

        Written

        --| Number of bytes written

          : Integer := 0;

        function to_FH is new Unchecked_Conversion( Source => HANDLE,

                                                    Target => File_Handle );

      begin

          Written := Write_File               -- use write pipe

                     ( to_FH(Event), --(Send)),

                       Message(1..1) );

          return Written = 1;

      end;

    else

      declare

        Result : BOOL := TRUEint;

      begin

        Result := SetEvent( Event => Event );

--<<< can't use with Linux >>>

        return Result /= FALSEint;

      end;

    end if;

  end Set_Event;

  ---------------------------------------------------------------------------

  -- Processes

  function Execute_Program

  ( Name : in String

    --| Program name to be executed

  ) return PId_t is

  -- ++

  --| Notes:

  --|   GNAT s-os_lib.ads for the Spawn procedure has the following:

  --  This procedure spawns a program with a given list of arguments. The

  --  first parameter of is the name of the executable. The second parameter

  --  contains the arguments to be passed to this program. Success is False

  --  if the named program could not be spawned or its execution completed

  --  unsuccessfully. Note that the caller will be blocked until the

  --  execution of the spawned program is complete. For maximum portability,

  --  use a full path name for the Program_Name argument. On some systems

  --  (notably Unix systems) a simple file name may also work (if the

  --  executable can be located in the path).

  --

  --  Spawning processes from tasking programs is not recommended. See

  --  "NOTE: Spawn in tasking programs" below.

  --

  --  Note: Arguments in Args that contain spaces and/or quotes such as

  --  "--GCC=gcc -v" or "--GCC=""gcc -v""" are not portable across all

  --  operating systems, and would not have the desired effect if they were

  --  passed directly to the operating system. To avoid this problem, Spawn

  --  makes an internal call to Normalize_Arguments, which ensures that such

  --  arguments are modified in a manner that ensures that the desired effect

  --  is obtained on all operating systems. The caller may call

  --  Normalize_Arguments explicitly before the call (e.g. to print out the

  --  exact form of arguments passed to the operating system). In this case

  --  the guarantee a second call to Normalize_Arguments has no effect

  --  ensures that the internal call will not affect the result. Note that

  --  the implicit call to Normalize_Arguments may free and reallocate some

  --  of the individual arguments.

  --

  --  This function will always set Success to False under VxWorks and other

  --  similar operating systems which have no notion of the concept of

  --  dynamically executable file. Otherwise Success is set True if the exit

  --  status of the spawned process is zero.

  --|

  --|   Argument_List is a subtype of String_List.  String_List is in

  --|   s-string.ads as

  --|     type String_List is array (Positive range <>) of String_Access;

  --|   where String_Access is

  --|     type String_Access is access all String;

  -- --

    Arg  : GNAT.OS_Lib.Argument_List(1..1) := ( others => null );

    Arg1 : GNAT.OS_Lib.String_Access := new String(1..10);

    Id   : GNAT.OS_Lib.Process_Id;

    use type System.Address;

    function to_PId is new Unchecked_Conversion

                           ( Source => GNAT.OS_Lib.Process_Id,

                             Target => PId_t );

  begin -- Execute_Program

console.write("Execute_Program",1,Name);--ArgV_Type'last,Name);

    Arg1.all := ( others => ' ' ); -- empty argument

    Arg(1) := Arg1;

--    for I in 1..ArgV_Type'last loop

    --if Args(I) /= System.Null_Address then

--console.write(" ",I,to_Int(Args(I)));

--        Arg(I) := to_Access(Args(I));

    --else

    --  Arg(I) := ASCII.NUL;

--      exit when Args(I) = System.Null_Address;

--declare

--gx : string(1..50);

--J : integer;

--begin

--J := 1;

--while Args(I)

--      for K in N_Args'Range loop

--         N_Args (K) := new String'(Args (K).all);

--      end loop;

--console.write(Args(I));

--end;

--    end loop;

-->>> could check that string pointed to by Arg is null terminated

console.write("Execute_Program call");

    Id := GNAT.OS_Lib.Non_Blocking_Spawn( Program_Name => Name,

                                          Args         => Arg );

    return to_PId(Id);

  end Execute_Program;

  procedure ExitProcessWindows                          -- winbase.h:1500

  ( ExitCode : UINT );

--<<< not for Linux >>>

  pragma Import( Stdcall, ExitProcessWindows, "ExitProcess" ); -- winbase.h:1500

  procedure ExitProcess                          -- winbase.h:1500

  ( ExitCode : UINT

  ) is

  begin -- ExitProcess

    if Op_Sys = Linux then

      Console.Write_Error("<<< ExitProcess Linux entered >>>");

    else

      ExitProcessWindows( ExitCode => ExitCode );

    end if;

  end ExitProcess;

  function GetExitCodeProcessWindows                    -- winbase.h:1515

  ( Process  : HANDLE;

    ExitCode : LPDWORD

  ) return BOOL;

--<<< not for Linux >>>

  pragma Import( Stdcall, GetExitCodeProcessWindows, "GetExitCodeProcess" ); -- winbase.h:1515

  function GetExitCodeProcess                    -- winbase.h:1515

  ( Process  : HANDLE;

    ExitCode : LPDWORD

  ) return BOOL is

  begin -- GetExitCodeProcess

    if Op_Sys = Linux then

      Console.Write_Error("<<<GetExitCodeProcess Linux entered>>>");

      return Falseint;

    else

      return GetExitCodeProcessWindows( Process  => Process,

                                        ExitCode => ExitCode );

    end if;

  end GetExitCodeProcess;

  function GetExitCodeThreadWindows                     -- winbase.h:1686

  ( Thread   : HANDLE;

    ExitCode : LPDWORD

  ) return BOOL;

--<<< not for Linux >>>

  pragma Import( Stdcall, GetExitCodeThreadWindows, "GetExitCodeThread" ); -- winbase.h:1686

  function GetExitCodeThread                     -- winbase.h:1686

  ( Thread   : HANDLE;

    ExitCode : LPDWORD

  ) return BOOL is

  begin -- GetExitCodeThread

    if Op_Sys = Linux then

      Console.Write_Error("<<<GetExitCodeThread Linux entered>>>");

      return Falseint;

    else

      return GetExitCodeThreadWindows( Thread   => Thread,

                                       ExitCode => ExitCode );

    end if;

  end GetExitCodeThread;

  function GetCurrentProcessWindows                     -- winbase.h:1486

  return HANDLE;

  pragma Import( Stdcall, GetCurrentProcessWindows, "GetCurrentProcess" ); -- winbase.h:1486

--<<< not for Linux >>>

  function GetCurrentProcess                     -- winbase.h:1486

  return HANDLE is

  begin -- GetCurrentProcess

    if Op_Sys = Linux then

console.write_error("<<<In GetCurrentProcess>>>");

      return System.Null_Address;

    else

      return GetCurrentProcessWindows;

    end if;

  end GetCurrentProcess;

  function GetCurrentProcessIdWindows                   -- winbase.h:1493

  return DWORD;

  pragma Import( Stdcall, GetCurrentProcessIdWindows, "GetCurrentProcessId" ); -- winbase.h:1493

--<<< not for Linux >>>

--  function GetCurrentProcessIdWindows                   -- winbase.h:1493

--  return DWORD is

--    use type DWORD;

--  begin

--console.write_error("<<<In GetCurrentProcessId>>>");

--    return -1;

--  end;

  function GetCurrentProcessId                   -- winbase.h:1493

  return DWORD is

    use type DWORD;

  begin -- GetCurrentProcessId

    if Op_Sys = Linux then

console.write_error("<<<In GetCurrentProcessId Linux>>>");

      return -1;

    else

      return GetCurrentProcessIdWindows;

    end if;

  end GetCurrentProcessId;

  function GetProcessShutdownParametersWindows

  ( Level : in LPDWORD;

    Flags : in LPDWord

  ) return Bool;

--<<< not for Linux >>>

  pragma Import( Stdcall, GetProcessShutdownParametersWindows, -- winbase.h:3748

                         "GetProcessShutdownParameters" );

  function GetProcessShutdownParameters

  ( Level : in LPDWORD;

    Flags : in LPDWord

  ) return Bool is

  begin -- GetProcessShutdownParameters

    if Op_Sys = Linux then

console.write_error("<<<In GetProcessShutdownParameters Linux>>>");

      return Falseint;

    else

      return GetProcessShutdownParametersWindows( Level => Level,

                                                  Flags => Flags );

    end if;

  end GetProcessShutdownParameters;

--  function Is_Running  -- for Linux

--  ( Path : String

    --| Full path of executable

--  ) return Boolean is

--    Dir_Entity

    --| Pointer to process directory entity

--    : Dir_Entity_Ptr_Type := null;

--    Dir_Proc

    --| Pointer to process directory

--    : System.Address := System.Null_Address;

--    Lookup_Name

    --| Process id for /proc lookup

--    : String(1..50);

--    Name_Len

    --| Number of characters in name

--    : Integer;

--    Proc_Directory

    --| Null-terminated name of directory containing running processes

--    : String(1..10) := ( others => ASCII.NUL );

--    Running_Process

    --| Path of running process

--    : String(1..256);

--    use type String_Tools.Comparison_Type;

--    use type System.Address;

--  begin -- Is_Running

    --| Logic_Step:

    --|   Open the /proc directory.

--    Proc_Directory(1..6) := "/proc/"; -- nul terminated

--    Dir_Proc := OpenDir( File_Name => Proc_Directory );

--    if Dir_Proc = System.Null_Address then

--      Console.Write_Error( "Couldn't open the /proc/ directory" );

--      return False;

--    end if;

    --| Logic_Step:

    --|   Search through the processes looking for the one with the

    --|   specified path and executable name.

--    loop

      -- Read next item

--      Dir_Entity := ReadDir(Dir_Proc);

--      exit when Dir_Entity = null;

      -- Form lookup name

--      Name_Len := 0;

--      for I in 1..Dir_Entity.d_name'length loop

--        exit when Dir_Entity.d_name(I) = ASCII.NUL; -- trailing NUL

--        Name_Len := I; -- set length of name to last non-NUL character

--      end loop;

--      if Name_Len > 0 then

--        Lookup_Name(1..6) := "/proc/";

--        Lookup_Name(7..6+Name_Len) := Dir_Entity.d_name(1..Name_Len);

--        Lookup_Name(7+Name_Len..10+Name_Len) := "/exe";

--        Lookup_Name(11+Name_Len) := ASCII.NUL; -- trailing NUL

----declare

----name_len1 : Integer := Name_Len;

----begin

        -- Get path

--        Name_Len := ReadLink( Lookup_Name'address,

--                              Running_Process'address,

--                              Running_Process'length );

----console.write("Is_Running",Name_Len,Name_Len1,Path'length,

----Dir_Entity.d_name(1..Name_Len1));

----end;

        -- Compare path of running executable with that input

--        if Name_Len = Path'length and then

--           String_Tools.Blind_Compare

--           ( Left  => Running_Process(1..Name_Len),

--             Right => Path ) = String_Tools.Equal

--        then

--          return True; -- process is running

--        end if;

--      end if; -- Name_Len > 0

--    end loop;

--    return False; -- Path not found in running processes

--  end Is_Running;

  function App_Running

  ( Application : in Interfaces.C.Strings.Chars_Ptr

  ) return Interfaces.C.char;

  pragma Import(C, App_Running, "appRunningC");

--<<< not for Linux >>>

  function Is_Running_Linux

  ( Path : String

    --| Full path of executable

  ) return Boolean is

    Dir_Entity

    --| Pointer to process directory entity

    : Dir_Entity_Ptr_Type := null;

    Dir_Proc

    --| Pointer to process directory

    : System.Address := System.Null_Address;

    Lookup_Name

    --| Process id for /proc lookup

    : String(1..50);

    Name_Len

    --| Number of characters in name

    : Integer;

    Proc_Directory

    --| Null-terminated name of directory containing running processes

    : String(1..10) := ( others => ASCII.NUL );

    Running_Process

    --| Path of running process

    : String(1..256);

    use type String_Tools.Comparison_Type;

    use type System.Address;

  begin -- Is_Running_Linux

    --| Logic_Step:

    --|   Open the /proc directory.

    Proc_Directory(1..6) := "/proc/"; -- nul terminated

    Dir_Proc := OpenDir( File_Name => Proc_Directory );

    if Dir_Proc = System.Null_Address then

      Console.Write_Error( "Couldn't open the /proc/ directory" );

      return False;

    end if;

    --| Logic_Step:

    --|   Search through the processes looking for the one with the

    --|   specified path and executable name.

    loop

      -- Read next item

      Dir_Entity := ReadDir(Dir_Proc);

      exit when Dir_Entity = null;

      -- Form lookup name

      Name_Len := 0;

      for I in 1..Dir_Entity.d_name'length loop

        exit when Dir_Entity.d_name(I) = ASCII.NUL; -- trailing NUL

        Name_Len := I; -- set length of name to last non-NUL character

      end loop;

      if Name_Len > 0 then

        Lookup_Name(1..6) := "/proc/";

        Lookup_Name(7..6+Name_Len) := Dir_Entity.d_name(1..Name_Len);

        Lookup_Name(7+Name_Len..10+Name_Len) := "/exe";

        Lookup_Name(11+Name_Len) := ASCII.NUL; -- trailing NUL

--declare

--name_len1 : Integer := Name_Len;

--begin

        -- Get path

        Name_Len := ReadLink( Lookup_Name'address,

                              Running_Process'address,

                              Running_Process'length );

--console.write("Is_Running",Name_Len,Name_Len1,Path'length,

--Dir_Entity.d_name(1..Name_Len1));

--end;

        -- Compare path of running executable with that input

        if Name_Len = Path'length and then

           String_Tools.Blind_Compare

           ( Left  => Running_Process(1..Name_Len),

             Right => Path ) = String_Tools.Equal

        then

          return True; -- process is running

        end if;

      end if; -- Name_Len > 0

    end loop;

    return False; -- Path not found in running processes

  end Is_Running_Linux;

  function Is_Running_Windows

  ( Path : String

  ) return Boolean is

    function to_Byte is new Unchecked_Conversion

                            ( Source => Interfaces.C.char,

                              Target => Machine.Unsigned_Byte );

    function to_Char is new Unchecked_Conversion

                            ( Source => Machine.Unsigned_Byte,

                              Target => Interfaces.C.char );

    Result

    : Interfaces.C.char := to_Char(16#0#);

    use type Machine.Unsigned_Byte;

    function to_Ptr is new Unchecked_Conversion

                           ( Source => System.Address,

                             Target => Interfaces.C.Strings.Chars_Ptr );

  begin -- Is_Running_Windows

    Result := App_Running( Application => to_Ptr(Path'address) );

-- <<< not for Linux >>>

    return to_Byte(Result) = 16#01#;

  end Is_Running_Windows;

  function Is_Running

  ( Path : String

  ) return Boolean is

  begin -- Is_Running

    if Op_Sys = Linux then

      return Is_Running_Linux( Path => Path );

    else

      return Is_Running_Windows( Path => Path );

    end if;

  end Is_Running;

  function GetPriorityClassWindows                      -- winbase.h:6260

  ( Process : HANDLE

  ) return DWORD;

--<<<< not for Linux >>>>

  pragma Import( Stdcall, GetPriorityClassWindows,      -- winbase.h:6260

                         "GetPriorityClass");

  function GetPriorityClass                      -- winbase.h:6260

  ( Process : HANDLE

  ) return DWORD is

  begin -- GetPriorityClass

    if Op_Sys = Linux then

console.write_error("<<<Entered GetPriorityClass Linux>>>");

      return 0;

    else

      return GetPriorityClassWindows( Process => Process );

    end if;

  end GetPriorityClass;

  function SetPriorityClassWindows                      -- winbase.h:6252

  ( Process       : HANDLE;

    PriorityClass : DWORD

  ) return BOOL;

--<<< can't be used for Linux >>>

  pragma Import( Stdcall, SetPriorityClassWindows, "SetPriorityClass" ); -- winbase.h:6252

  function SetPriorityClass                      -- winbase.h:6252

  ( Process       : HANDLE;

    PriorityClass : DWORD

  ) return BOOL is

  begin -- SetPriorityClass

    if Op_Sys = Linux then

console.write_error("<<<SetPriorityClass Linux entered>>>");

      return FALSEint;

    else

      return SetPriorityClassWindows( Process       => Process,

                                      PriorityClass => PriorityClass );

    end if;

  end SetPriorityClass;

  ---------------------------------------------------------------------------

  -- Threads

  type PThread_t is new Interfaces.C.Unsigned_Long; -- unsigned long int --Machine.Unsigned_Longword;

--<<<< need to be pointer?? >>>

  function Unsigned_Long_to_Int

  ( Source : in Interfaces.C.Unsigned_Long

  ) return Integer_Pair_Type is

    type Pair_Type

    is record

      Two : Machine.Unsigned_Word; -- to order for correct endian

      One : Machine.Unsigned_Word;

    end record;

    Temp1 : Pair_Type;

    for Temp1 use at Source'address;

    Temp2 : Integer_Pair_Type;

  begin -- Unsigned_Long_to_Int

    Temp2(1) := Integer(Temp1.One);

    Temp2(2) := Integer(Temp1.Two);

    return Temp2;

  end Unsigned_Long_to_Int;

  function PThread_Attr_Init -- for Linux

  ( Attributes : access PThread_Attr_t

  ) return Interfaces.C.int;

  -- Return attribute structure with default attribute values

--  pragma Import(C, PThread_Attr_Init, "pthread_attr_init");

-- above needed for Linux

-- below to compile for Windows

  function PThread_Attr_Init -- to compile for Windows

  ( Attributes : access PThread_Attr_t

  ) return Interfaces.C.int is

  begin

    Console.Write_Error("<<<PThread_Attr_Init entered>>>");

    return Interfaces.C.int(-1);

  end;

  function PThread_Attr_SetStacksize

  ( Attributes : access PThread_Attr_t;

    Stack_Size : Natural

  ) return Interfaces.C.int;

  -- Set stack size into thread attributes

--  pragma Import(C, PThread_Attr_SetStacksize, "pthread_attr_setstacksize");

-- above needed for Linux

-- below to compile for Windows

  function PThread_Attr_SetStacksize

  ( Attributes : access PThread_Attr_t;

    Stack_Size : Natural

  ) return Interfaces.C.int is

  begin

    Console.Write_Error("<<<PThread_Attr_SetStacksize entered>>>");

    return Interfaces.C.int(-1);

  end;

  function PThread_Create

  ( Thread_Id  : in System.Address; -- location for thread id

    Attributes : in System.Address; -- location of thread attributes to use

    Start      : in System.Address; -- pointer to start address for thread

    Arg        : in System.Address  -- location of arguments for Start

  ) return Interfaces.C.int;

  -- Create a thread and return its identifier at Thread_Id.  The return

  -- value is whether the create was successful (0) or an error number of

  --  EAGAIN Insufficient resources to create another thread, or a

  --         system-imposed limit on the number of threads was encountered.

  --         The latter case may occur in two ways: the RLIMIT_NPROC soft

  --         resource limit (set via setrlimit(2)), which limits the number

  --         of process for a real user ID, was reached; or the kernel's

  --         system-wide limit on the number of threads,

  --         /proc/sys/kernel/threads-max, was reached.

  --  EINVAL Invalid settings in attr.

  --  EPERM  No permission to set the scheduling policy and parameters

  --         specified in attr.

  --|

  --| Notes:

  --|   This Create_Thread uses the C pthread_create.  It returns the thread

  --|   id that the other C functions use.  It also results in the Arg

  --|   address being the same when the thread starts as that supplied to

  --|   Create.

--> Need to find out the format of Attributes to know how to pass stack size, etc.

--> pthread_attr_t

-->          /* Initialize thread creation attributes */

-->           s = pthread_attr_init(&attr);

-->           if (s != 0)

-->               handle_error_en(s, "pthread_attr_init");

-->           if (stack_size > 0) {

-->               s = pthread_attr_setstacksize(&attr, stack_size);

-->               if (s != 0)

-->                   handle_error_en(s, "pthread_attr_setstacksize");

-->           }

--  pragma Import(C, PThread_Create, "pthread_create");

-- needed for Linux

  function PThread_Create

  ( Thread_Id  : in System.Address; -- location for thread id

    Attributes : in System.Address; -- location of thread attributes to use

    Start      : in System.Address; -- pointer to start address for thread

    Arg        : in System.Address  -- location of arguments for Start

  ) return Interfaces.C.int is

  begin -- PThread_Create

    Console.Write_Error("<<<PThread_Create entered>>>");

    return Interfaces.C.int(-1);

  end PThread_Create;

-- needed to compile for Windows

-- for Linux

  procedure Create_Thread_Linux

  (-- Attributes : in PThread_Attr_t;

    Stack_Size    : in Integer;

    Start         : in System.Address;

    Thread_Number : in  Integer;

    Thread_Id     : out Integer;

    Success       : out Boolean

  ) is --return Boolean is

    Attributes

    : PThread_Attr_t;

    type Attributes_Ptr_Type is access PThread_Attr_t;

    function to_Attr_Ptr is new Unchecked_Conversion

                                ( Source => System.Address,

                                  Target => Attributes_Ptr_Type );

    Attributes_Ptr : Attributes_Ptr_Type := to_Attr_Ptr(Attributes'address);

    Result

    : Interfaces.C.int;

    StackSize

    : Integer := Stack_Size;

    type Dummy_Type is array(1..10) of Integer;

    type Thread_Info_Type

    is record

      Thread_Id : PThread_t;      -- Identifier returned by pthread_create

      Argv      : System.Address; -- pointer to command-line argument

      Spare     : Dummy_Type;     -- be sure reserve enough space

    end record;

    Thread_Info

    : Thread_Info_Type;

    pragma Volatile(Thread_Info);

    use type Interfaces.C.int;

  begin -- Create_Thread_Linux

    Result := PThread_Attr_Init( Attributes => Attributes_Ptr );

console.write("Create_Thread attr_init",integer(Result),stack_size);

    if StackSize <= 0 then

      StackSize := 16384;

    end if;

    Result := PThread_Attr_SetStacksize( Attributes_Ptr,

                                         StackSize );

    Exec_Itf.Log_Error;

console.write("Create_Thread setstacksize",integer(Result));

--console.write("call exec_itf Thread_Create",integer(Thread_Number));

 --   Result := Thread_Create

 --             ( Thread_Id  => Thread_Id,    -- location for thread id

 --               Attributes => Attributes'address, -- location of thread attributes to use

 --               Start      => Start,        -- pointer to start address

 --               Arg        => Parameters ); -- parameters

    --| Notes:

    --|   Parameters needs to be of the form

    --|    Parameters.thread_num where thread number starts at 1 and increases for each thread

    --|    Parameters.argv_string = argv[optind + tnum] where tnum is one less than thread_num

 --   Thread_Info.Thread_Id  := 0;

 --   Thread_Info.Thread_Num := Thread_Number;

    Thread_Info.Thread_Id  := PThread_t(Thread_Number);

    Thread_Info.Argv       := System.Null_Address;

console.write("call exec_itf PThread_Create",integer(Thread_Number));

    Result := PThread_Create

              ( Thread_Id  => Thread_Number'address, --Thread_Info.Thread_Id'address,  -- &tinfo[tnum].thread_id, &attr,

                Attributes => Attributes'address,

                Start      => Start,     -- &thread_start, &tinfo[tnum]);

                Arg        => Thread_Info'address ); --Parameters );

console.write("Create_Thread r1",integer(Result)); --,integer(Thread_Info.Thread_Id));--,integer(thread_number));

--declare

--  CTId1 : Integer_Pair_Type;

--  CTId2 : Integer_Pair_Type;

--begin

----CTId1 := unsigned_long_to_int(Interfaces.C.unsigned_long(thread_number));

--CTId2 := unsigned_long_to_int(Interfaces.C.unsigned_long(Thread_Info.Thread_Id));

----console.write_hex("Create_Thread r2",CTId1(1),CTId1(2));

--console.write_hex("Create_Thread r3",CTId2(1),CTId2(2));

--null;

--end;

    if Result = 0 then

      Thread_Id := Integer(Thread_Info.Thread_Id);

      Success := True;

    else

      Thread_Id := -1;

      Success := False;

    end if;

    --| Logic_Step:

    --|   Return true if thread created.

--    return Result = 0;

  end Create_Thread_Linux;

-- for Linux

--  function Create_Thread

--  (-- Attributes : in PThread_Attr_t;

--    Stack_Size : in Integer;

--    Start      : in System.Address;

--    Parameters : in System.Address;

--    Thread_Id  : in System.Address

--  ) return Boolean is

--    Attributes

--    : PThread_Attr_t;

--    type Attributes_Ptr_Type is access PThread_Attr_t;

--    function to_Attr_Ptr is new Unchecked_Conversion

--                                ( Source => System.Address,

--                                  Target => Attributes_Ptr_Type );

--    Attributes_Ptr : Attributes_Ptr_Type := to_Attr_Ptr(Attributes'address);

--    Result

--    : Interfaces.C.int;

--    use type Interfaces.C.int;

--  begin -- Create_Thread

--    Result := PThread_Attr_Init( Attributes => Attributes_Ptr );

--console.write("Thread_Create attr_init",integer(Result));

--    if Stack_Size > 0 then

--      Result := PThread_Attr_SetStacksize( Attributes_Ptr,

--                                           Stack_Size );

--      Exec_Itf.Log_Error;

--console.write("Thread_Create setstacksize",integer(Result));

--    end if;

--    Result := Thread_Create

--              ( Thread_Id  => Thread_Id,    -- location for thread id

--                Attributes => Attributes'address, -- location of thread attributes to use

--                Start      => Start,        -- pointer to start address

--                Arg        => Parameters ); -- parameters

--console.write("Create_Thread",integer(Result));--,TId_to_Int(TId));

    --| Logic_Step:

    --|   Return true if thread created.

--    return Result = 0;

--  end Create_Thread;

--<<< above not for Windows >>>

  function Create_Thread

  ( Start      : in System.Address;          -- pointer

    Parameters : in Void_Ptr;                -- pointer

    Stack_Size : in Natural;                 -- int

    Priority   : in Integer                  -- int

  ) return HANDLE is

  begin -- Create_Thread

    return GNAT.Threads.Create_Thread

           ( Code => Start,

             Parm => GNAT.Threads.Void_Ptr(Parameters),

             Size => Stack_Size,

             Prio => Priority );

  end Create_Thread;

  procedure Create_Thread

  ( Start           : System.Address;   -- pointer to start address of thread

    Parameter       : System.Address;   -- pointer to parameters

    Stack_Size      : Natural;          -- stack size in bytes

    Thread_Priority : Integer;          -- priority for thread

    Thread_Handle   : out Thread_Handle_Type

  ) is

  --| Notes:

  --|   This procedure does not return a Thread_Id that matches that of

  --|   GetCurrentThreadId.

    Thread_Ident : System.Address;

    function to_Id is new Unchecked_Conversion

                          ( Source => System.Address,

                            Target => Thread_Handle_Type );

 function to_Int is new Unchecked_Conversion

                        ( Source => System.Address,

                          Target => Integer );

 function to_Ptr is new Unchecked_Conversion

                        ( Source => System.Address,

                          Target => GNAT.Threads.Void_Ptr );

  begin -- Create_Thread

    Thread_Ident := GNAT.Threads.Create_Thread

                    ( Code => Start,

                      Parm => to_Ptr(Parameter),

                      Size => Stack_Size,

                      Prio => Thread_Priority );

    Thread_Handle := to_Id(Thread_Ident);

  end Create_Thread;

  procedure Destroy_Thread

  ( Thread_Handle : Thread_Handle_Type

  ) is

    function to_Addr is new Unchecked_Conversion

                            ( Source => Thread_Handle_Type,

                              Target => System.Address );

  begin -- Destroy_Thread

    GNAT.Threads.Destroy_Thread( to_Addr(Thread_Handle) );

  end Destroy_Thread;

  function PThread_Self --GetCurrentThreadIdLinux

  return Thread_Id_Type; --pThread_t;

  -- This function gets the system identifier of the currently running thread.

--  pragma Import (C, PThread_Self, "pthread_self");

  --<<< above pragma necessary for Linux >>>

  function PThread_Self --<<< this is just to compile for Windows >>>

  return Thread_Id_Type is

  begin

    Console.Write("<<<PThread_Self entered>>>");

    return 0;

  end PThread_Self;

--<< Windows version >>

  function GetCurrentThreadIdWindows             -- winbase.h:1630

  return DWORD;

  pragma Import( Stdcall, GetCurrentThreadIdWindows, "GetCurrentThreadId" );   -- winbase.h:1630

--<<< not for Linux >>>

  function GetCurrentThreadId

  return Thread_Id_Type is

    use type Interfaces.C.unsigned_long;

    Thread_Id : DWORD := -1;

    T_Id : Thread_Id_Type;

  begin -- GetCurrentThreadId

    if Op_Sys = Linux then

      T_Id := PThread_Self;

declare

  CTId : Integer_Pair_Type;

begin

CTId := unsigned_long_to_int(Interfaces.C.unsigned_long(T_Id));

console.write_hex("GetCurrentThreadId",CTId(1),CTId(2));

end;

      return T_Id;

    else

      Thread_Id := GetCurrentThreadIdWindows;

      return Thread_Id_Type(Thread_Id);

    end if;

  end GetCurrentThreadId;

  function GetCurrentThreadWindows                      -- winbase.h:1623

  return HANDLE;

  pragma Import( Stdcall, GetCurrentThreadWindows, "GetCurrentThread" ); -- winbase.h:1623

--<<< only for Windows >>>

  function GetCurrentThread                      -- winbase.h:1623

  return HANDLE is

  begin -- GetCurrentThread

    if Op_Sys = Linux then

console.Write_Error("<<<GetCurrentThread Linux entered>>>");

      return System.Null_Address;

    else

      return GetCurrentThreadWindows;

    end if;

  end GetCurrentThread;

  procedure Get_Thread -- get thread identifier from handle

  ( Thread_Handle : in HANDLE;

    Thread_Id     : out PId_t

  ) is

    Id_Addr : System.Address;-- := System.Null_Address;

    pragma Volatile(Id_Addr);

    Id : PId_t;

    for Id use at Id_Addr;

    pragma Volatile(Id);

function to_int is new unchecked_conversion( Source => PId_t, Target => Integer );

    function TH_to_Int is new Unchecked_Conversion

                            ( Source => Handle,

                              Target => Integer );

  begin -- Get_Thread

    GNAT.Threads.Get_Thread( Id     => Thread_Handle,

                             Thread => Id_Addr );

    Thread_Id := Id;

  end Get_Thread;

  procedure Get_Thread

  ( Thread_Handle : in Thread_Handle_Type;

    Thread_Id     : out Thread_Id_Type

  ) is

    function TH_to_Addr is new Unchecked_Conversion

                            ( Source => Thread_Handle_Type,

                              Target => System.Address );

    function TH_to_Int is new Unchecked_Conversion

                            ( Source => Thread_Handle_Type,

                              Target => Integer );

    function TId_to_Int is new Unchecked_Conversion

                            ( Source => Thread_Id_Type,

                              Target => Integer );

  begin

console.write("Get_Thread b",TH_to_Int(Thread_Handle));

    GNAT.Threads.Get_Thread( Id     => TH_To_Addr(Thread_Handle),

                             Thread => Thread_Id'address );

console.write("Get_Thread",TH_to_Int(Thread_Handle),TId_to_Int(Thread_Id));

  end Get_Thread;

  function GetThreadPriorityWindows                     -- winbase.h:1653

  ( Thread : HANDLE

  ) return INT;

--<<< not for Linux >>>

  pragma Import( Stdcall, GetThreadPriorityWindows, "GetThreadPriority" ); -- winbase.h:1653

  function GetThreadPriority                     -- winbase.h:1653

  ( Thread : HANDLE

  ) return INT is

  begin -- GetThreadPriority

    if Op_Sys = Linux then

console.write_error("<<<GetThreadPriority Linux entered>>>");

      return 0;

    else

      return GetThreadPriorityWindows( Thread => Thread );

    end if;

  end GetThreadPriority;

  function SetThreadPriorityWindows                     -- winbase.h:1645

  ( Thread   : HANDLE;

    Priority : INT

  ) return BOOL;

  pragma Import( Stdcall, SetThreadPriorityWindows, "SetThreadPriority" ); -- winbase.h:1645

--<<< not for Linux >>>

  function SetThreadPriority

  ( Thread   : HANDLE;

    Priority : INT

  ) return Boolean is

    Result : BOOL := FALSEint;

  begin -- SetThreadPriority

    if Op_Sys = Windows then

      Result := SetThreadPriorityWindows( Thread   => Thread,

                                          Priority => Priority );

--<<< can't use with Linux >>>

      return Result /= FALSEint;

    else

      console.Write_Error("<<<SetThreadPriority entered>>>");

      return False; -- not for Linux

    end if;

  end SetThreadPriority;

  function TerminateThreadWindows                       -- winbase.h:1678

  ( Thread   : HANDLE;

    ExitCode : DWORD

  ) return BOOL;

  pragma Import( Stdcall, TerminateThreadWindows, "TerminateThread" ); -- winbase.h:1678

--<<< not for Linux >>>

  function TerminateThread                       -- winbase.h:1678

  ( Thread   : HANDLE;

    ExitCode : DWORD

  ) return BOOL is

  begin -- TerminateThread

    if Op_Sys = Linux then

Console.Write_Error("<<<TerminateThread entered>>>");

      return FALSEint;

    else

      return TerminateThreadWindows( Thread   => Thread,

                                     ExitCode => ExitCode );

    end if;

  end TerminateThread;

  function To_Task_Id

  ( Thread_Handle : in Thread_Handle_Type

  ) return Ada.Task_Identification.Task_Id is

  begin -- To_Task_Id

    return GNAT.Threads.To_Task_Id( Thread_Handle'address );

  end To_Task_Id;

  ---------------------------------------------------------------------------

  -- Time

  function Current_Time

  return OS_Time is

  --  Return the system clock value as OS_Time

  begin -- Current_Time

    return GNAT.OS_Lib.Current_Time;

  end Current_Time;

  procedure GetLocalTimeWindows                         -- winbase.h:2627

  ( SystemTime : LPSYSTEMTIME

  );

--<<< not usable for Linux >>>

  pragma Import( Stdcall, GetLocalTimeWindows, "GetLocalTime" ); -- winbase.h:2627

  procedure GetLocalTime                         -- winbase.h:2627

  ( SystemTime : LPSYSTEMTIME

  ) is

  begin

    if Op_Sys = Linux then

      console.write("<<<GetLocalTime Linux entered>>>");

    else

      GetLocalTimeWindows( SystemTime => SystemTime );

    end if;

  end;

  procedure GM_Split

  ( Date     : OS_Time;

    Year     : out Year_Type;

    Month    : out Month_Type;

    Day      : out Day_Type;

    Hour     : out Hour_Type;

    Minute   : out Minute_Type;

    Second   : out Second_Type;

    Millisec : out Millisec_Type

  ) is

  begin -- GM_Split

    GNAT.OS_Lib.GM_Split

    ( Date   => Date,

      Year   => Year,

      Month  => Month,

      Day    => Day,

      Hour   => Hour,

      Minute => Minute,

      Second => Second );

    Millisec := 0;

  end GM_Split;

  function System_Time

  ( Time : OS_Time

    --| System clock value

  ) return System_Time_Type is

  --| Return system clock value as a record.

    Year     : Year_Type;

    Month    : Month_Type;

    Day      : Day_Type;

    Hour     : Hour_Type;

    Minute   : Minute_Type;

    Second   : Second_Type;

    Millisec : Millisec_Type;

    Tm : System_Time_Type; --Split_Time_Type;

  begin -- System_Time

    GM_Split( Date     => Time,

              Year     => Year,

              Month    => Month,

              Day      => Day,

              Hour     => Hour,

              Minute   => Minute,

              Second   => Second,

              Millisec => Millisec );

    Tm := ( Year     => Year,

            Month    => Month,

            Day      => Day,

            Hour     => Hour,

            Minute   => Minute,

            Second   => Second,

            Millisec => Millisec );

    return Tm;

  end System_Time;

  function SystemTime

  return System_Time_Type is

    Time : OS_Time;

  begin -- SystemTime

    Time := Current_Time;

    return System_Time( Time );

  end SystemTime;

  function File_Time_Stamp

  ( Name : String

  ) return OS_Time is

  --  Given the name of a file or directory, Name, obtains and returns the

  --  time stamp. This function can be used for an unopened file. Returns

  --  Invalid_Time is Name doesn't correspond to an existing file.

  begin -- File_Time_Stamp

    return GNAT.OS_Lib.File_Time_Stamp( Name => Name );

  end File_Time_Stamp;

  function File_Time_Stamp

  ( Handle : File_Handle

  ) return OS_Time is

  begin -- File_Time_Stamp

    return GNAT.OS_Lib.File_Time_Stamp( Handle_to_File_Descriptor(Handle) );

  end File_Time_Stamp;

end Exec_Itf;

The Linux version is, of course, much like the above but with the pragma Import lines enabled for Linux and disabled for Windows and the code that is to provide a function in place of the Import commented out and vice versa for the Windows pragma Imports.

Notice that the detection of the operating system is done, via Set_Op_Sys, by obtaining the folder/directory from which the app was started and checking its beginning characters to see if C: or /home.

Packages with separate paths:

The units that have code that is dependent upon the operation system are

1) apps-configuration-initialize

2) display_pipe

3) exec-text_log

4) mc-exec

5) mc-message-remote-method and mc-message-remote-method-transmit

The usage in display pipe and in mc-message-remote-method has already been illustrated.

The usage in apps-configuration-initialize is for checking the configuration file designation of the supported communications file.

The usage in exec-text_log is to form a valid path for the log file.

The usage in mc-exec is to determine which exec_itf routines to call in instances where data is stored in the thread control block.  Different paths are mainly used for how events are treated and in the Thread_Create procedure that is reproduced below.

  procedure Thread_Create

  ( Thread_Name     : in Thread_Name_Type;

    Start           : in Exec_Itf.Thread_Address_Type;

    Parameter       : in System.Address;

    Stack_Size      : in Natural;

    Thread_Priority : in Thread_Priority_Type;

    Immediate_Start : in Boolean := False;

    Thread_Id       : out Thread_Id_Type;

    Status          : out Status_Type

  ) is

    Assigned_Thread_Id

    --| Thread id assigned by Linux

    : Integer;

    pragma Volatile( Assigned_Thread_Id );

    T_Id

    --| Internal Thread identifier

    : Thread_Id_Ext_Type;

    pragma Volatile( T_Id );

    Thread_Created

    --| True if thread was created successfully

    : Boolean;

    Thread_Ident

    --| Thread identifier

    : Exec_Itf.PId_t;

    Thread_Handle

    --| Handle returned by Create_Thread

    : Exec_Itf.HANDLE; --Thread_Handle_Type; used in Linux version

    TId

    --| Thread identifier as converted type

    : Exec_Itf.Thread_Id_Type;

    pragma Volatile( TId );

    function to_Int is new Unchecked_Conversion

                           ( Source => Thread_Priority_Type,

                             Target => Integer );

    function TH_to_Int is new Unchecked_Conversion

                              ( Source => Exec_Itf.HANDLE,

                                Target => Integer );

    function TId_to_Int is new Unchecked_Conversion

                               ( Source => Exec_Itf.Thread_Id_Type,

                                 Target => Integer );

    function to_Int2 is new Unchecked_Conversion

                            ( Source => System.Address,

                              Target => Integer );

    function to_Addr is new Unchecked_Conversion

                            ( Source => Exec_Itf.Void_Ptr,

                              Target => System.Address );

    function to_Void_Ptr is new Unchecked_Conversion

                                ( Source => System.Address,

                                  Target => Exec_Itf.Void_Ptr );

    use type Exec_Itf.Op_Sys_Type;

    use type Exec_Itf.Thread_Id_Type;

    use type Interfaces.C.int;

    use type System.Address;

  begin -- Thread_Create

    --| Logic_Step:

    --|   Lock the thread semaphore to prevent another thread from

    --|   accessing the critical region.

    --| Note:

    --|   The created thread can starting running immediately suspending

    --|   the thread that invoked this Create and preventing it from

    --|   updating the TCB.  Therefore, the other thread can attempt other

    --|   Exec-mC procedures that would access the incomplete TCB.

    Thread_Lock;

    T_Id := 0;

    for I in Thread_Id_Type loop

      if not TCB(I).Created or else

         TCB(I).Status.Attributes.Name = Thread_Name

      then

        T_Id := I;

        exit;

      end if;

    end loop;

    if T_Id = 0                       or else

       Thread_Name = Null_Thread_Name or else

       Start       = Exec_Itf.Null_Thread_Address

    then

      Status := Invalid_Config;

    elsif TCB(T_Id).Created then

      Status := No_Action;

    else

      --| Logic_Step:

      --|   Buffer thread TCB index to be saved by Thread_Wait_for_Start that

      --|   is used as the start address for the thread for it to save on its

      --|   stack.  Also save the actual start address and the pointer to any

      --|   parameters for the thread to be used by Thread_Wait_for_Start to

      --|   invoke the actual thread code when Thread_Start is invoked.

      TCB(T_Id).FW_T_Id          := T_Id;

      TCB(T_Id).Thread_Address   := Start;

      TCB(T_Id).Thread_Parameter := Parameter;

      if Exec_Itf.Op_Sys = Exec_Itf.Windows then

        if Immediate_Start then

          Thread_Handle :=

            Exec_Itf.Create_Thread

            ( Start      => Thread_Immediate_Start'address,

              Parameters => to_Void_Ptr(TCB(T_Id).FW_T_Id'address),

              Stack_Size => Stack_Size,

              Priority   => Integer(Thread_Priority) );

        else -- not Immediate_Start

          Thread_Handle :=

            Exec_Itf.Create_Thread

            ( Start      => Thread_Wait_to_Start'address,

              Parameters => to_Void_Ptr(TCB(T_Id).FW_T_Id'address),

              Stack_Size => Stack_Size,

              Priority   => Integer(Thread_Priority) );

        end if; -- Immediate_Start

        Thread_Created := Thread_Handle > System.Null_Address;

      else -- Linux

        if Immediate_Start then

          Exec_Itf.Create_Thread_Linux

          ( Stack_Size    => Stack_Size,

            Start         => Thread_Immediate_Start'address,

            Thread_Number => Integer(T_Id),

            Thread_Id     => Assigned_Thread_Id,

            Success       => Thread_Created );

          TCB(T_Id).FW_T_Id := Thread_Id_Ext_Type(Assigned_Thread_Id);

        else -- not Immediate_Start

          Exec_Itf.Create_Thread_Linux

          ( Stack_Size    => Stack_Size,

            Start         => Thread_Wait_to_Start'address,

            Thread_Number => Integer(T_Id),

            Thread_Id     => Assigned_Thread_Id,

            Success       => Thread_Created );

          TCB(T_Id).FW_T_Id := Thread_Id_Ext_Type(Assigned_Thread_Id);

        end if; -- Immediate_Start

        Thread_Handle := Exec_Itf.INVALID_HANDLE_VALUE;

      end if; -- Exec_Itf.Op_Sys = Exec_Itf.Windows

      if Thread_Created then

        if Exec_Itf.Op_Sys = Exec_Itf.Windows then

          declare

            function to_Id is new Unchecked_Conversion

                                  ( Source => Exec_Itf.PId_t,

                                    Target => Exec_Itf.Thread_Id_Type );

          begin

            Exec_Itf.Get_Thread -- get thread identifier from handle

            ( Thread_Handle => Thread_Handle,

              Thread_Id     => Thread_Ident );

            TId := to_Id(Thread_Ident);

          end;

          TCB(T_Id).Thread_Handle := Thread_Handle;

        else -- Op_Sys = Linux

         --| Notes:

         --|   The pseudo thread instance that is started by the

         --|   Create_Thread above obtains the thread id in the case of

         --|   Windows.  Therefore, avoid overwriting the value here.

        TId := Exec_Itf.Thread_Id_Type(Assigned_Thread_Id);

    --  TCB(T_Id).Thread_Handle := Thread_Handle; -- no handle for Linux

        end if; -- Exec_Itf.Op_Sys = Exec_Itf.Windows;

    --  TCB(T_Id).Status.Attributes       := Attributes;

        TCB(T_Id).Status.Current_Priority := 0;

        TCB(T_Id).Status.Deadline_Time    := Aperiodic;

        TCB(T_Id).Status.Thread_State     := Dormant;

     -- TCB(T_Id).Win_Priority            := Thread_Priority;

     -- TCB(T_Id).Win_Thread_Class        := Thread_Class;

        TCB(T_Id).Created                 := True;

        Thread_Names_First_Letters(T_Id) := Thread_Name(1);

        Thread_Id := T_Id;

        Status    := No_Error;

      else -- Exec_Itf error

        TCB(T_Id).FW_T_Id   := 0;

        TCB(T_Id).Thread_Id := 0;

        TCB(T_Id).Created   := False;

        Thread_Id := 1;

        Status    := Invalid_Config;

        Console.Write("Exec Thread Create Error");

  --    raise Thread_Create_Fail;

      end if;

    end if;

    --| Logic_Step:

    --|   Unlock the thread semaphore to allow another thread to

    --|   access the critical region.

    Thread_Unlock;

  end Thread_Create;

Thread_Create initially starts the thread in one of two of the mc-exec packages own procedures to capture the currently running thread identifier as that of the started thread.  Then, for immediate start, the actual code of the thread is invoked.  For non-immediate start, the mc-exec code loops until the signal is received to start all the threads.  When each thread receives the signal in its instance of the Thread_Wait_to_Start procedure, the wait code invokes the actual code of the thread.