Using Windows-like Events in Linux

Using Windows-like Events in Linux

 Background

I am now at the beginning of converting my Exploratory Project to Linux.  I've installed Fedora in an external drive partition and installed GNAT gcc for Linux and began working with it.

First problem, of course, was with file naming since I had used leading upper case on my Windows file names and the Linux version of GNAT said all the files were misnamed.  So I had to find out how to make the names all lower case without needing to do it all brute force.  (Of course, Linux is case sensitive but it would seem that GNAT could have tried at least obvious variations of the name before giving up.)

Until beginning the conversion to Linux I thought that I had separated operating system depended code into a mC-Exec package and, after I had found the need to have some such routines callable from outside the mC framework, a minimal Exec package.  This was dispelled quickly when I found references to Win32Ada packages in a number of my project packages.

Therefore, I have started an Exec_Itf package to be able to gather together the needed Win32 system calls of the project in a way that there can be a set of common types and function / procedure declarations in the Exec_Itf Ada specification and the body can be replaced with an operating system dependent version; one for Win32 and another for Linux.

It soon became obvious that the needed Win32Ada types and procedures were not going to be directly compatible with Linux so the new Exec_Itf interface package would need to declare its own and that the package body would then need to make the necessary translations to use the available routines of the particular operating system.  This will require some changes in non-operating system code to use the new types and function/procedure declarations but seems like the better approach for the long run.

In using the newer versions of GNU GNAT that I now have available for Windows and Linux it has also became apparent that the Linux code can reference GNAT supplied packages directly in many cases where I previously used Win32Ada calls.  I assume that this will also be the case when I finish and return to the Windows version of the project.  So this is another reason to attempt to define new Exec_Itf types and procedures rather than attempt to mimic those of Win32Ada.

This has resulted in my starting a new Linux GNAT Test project in which I will attempt to create an interface for the Exec and mC-Exec to reference removing all references to Win32Ada packages while proceeding step-by-step.

So far I have provided what was needed to allow the Exec-Text_Log child package of Exec to create and write to a Linux log file rather than a Windows file and for the test Ada main to create and execute what will become framework component threads in the exploratory project.

This led me to want to be able to have the components block and have the main process thread send wakeup events to the components.  And then the gotcha occurred.

Linux Events

The Windows version of the project uses mC-Exec Event_Create to call the Win32Ada

Wn32.Winbase.CreateEvent procedure.  Looking for something to use with Linux I failed to come up with anything.  Google searches told me that Linux didn't have such a thing.

However, in response to another's question one or two responders mentioned using Linux pipes to implement the concept.  Thinking about this, it seemed workable enough.  That is, a thread waiting to read from a pipe would block until there was something to read.  Therefore, write a byte to the pipe to send an event and do a read from the pipe to wait for an event.  Same functionality.

Therefore I put the code into my test main to create the pipe – really a pair of pipes in Linux; a read pipe and a corresponding write pipe – and to the read and write to try it out.  Seemed to work well enough so I went ahead and began the test version of mC-Exec – in this case exec_mc since mC-Exec is only callable from within the framework and the GNAT test project has no framework.

This I was able to accomplish without the need to modify the interface so a good start – the exploratory project will be able to use "events" as it did with Windows.  (There no longer was the need to supply an event name since I am using unnamed pipes but the calling routine can, of course, supply a name that is just ignored.)

exec_mc Event Interface

This is the Ada package used by the framework (in the exploratory project) to supply an interface that can allow the framework code to be independent of the operating system being used.

package Exec_mC is -- test version of mC-Exec

--| OS/Executive Specific Interface
-- ++
--| Overview:
--|   This package, along with Exec_Itf, declares the types and methods to
--|   interface between mC and the particular operating system / executive
--|   of the target.
--| Notes:
--|   This package is private so that its procedures can only be called
--|   from child packages of mC and not from packages of components.  There
--|   is another Exec package for OS/executive specific procedures that can
--|   be called by non-mC packages.
-- --

The above note doesn't, of course, apply to this test package.

  type Interface_Integer

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

  Max_Name_Length

  : constant := 50;

  type Status_Type

  --| Status returned by system specific Exec procedures
  is ( No_Error,
       No_Action,
       Not_Available,
       Invalid_Param,
       Invalid_Config,
       Invalid_Mode,
       Timed_Out
     );

  type Time_Interval_Type

  -- 32-bit signed integer with 1 millisecond LSB
  is new Interface_Integer;
  for Time_Interval_Type'Alignment use 8;
 
  Infinite_Time
  --| Time Interval to indicate no timeout or no periodic time interval
  --| for a thread
  : constant Time_Interval_Type := -1;

  procedure Initialize;

  --| Initialize static data
 
  -------------------------------------------------------------------------
  --| Notes:                                                              |
  --|   Event types, constants, and functions.                            |
  --|                                                                     |
  --|   Events with Linux will be implemented via pipes.                  |
  -------------------------------------------------------------------------

  Max_Number_Of_Events

  : constant := 50;

  type Event_Id_Type

  --| Event Identifier
  is range 0..Max_Number_Of_Events;

  type Event_Name_Type

  --| Alphanumeric name of event
  --| Notes: This is the pipe path.
  is new String( 1..Max_Name_Length );

  Null_Event_Name

  --| Null event name
  : constant Event_Name_Type
  := ( others => ' ' );

  procedure Event_Create

  ( Event_Name : in Event_Name_Type;
    --| Event name (the name is not actually used for Linux pipes)
    Event_Id   : out Event_Id_Type;
    --| Identifier of created event
    Status     : out Status_Type
    --| Returned status
  );
  --| Create Event
  -- ++
  --| Overview:
  --|   This procedure creates a pair of Linux pipes to be used as an
  --|   event.
  --| Notes:
  --|   The Event_Id references an internal table of event data.  This
  --|   table, among other data, includes a pair of pipe handles where
  --|   the first handle of the pair is to wait on the pipe to read it
  --|   when a write occurs.  The second pipe handle of the pair is to
  --|   write to the pipe to wake up the thread waiting on the read.
  -- --

  procedure Event_Reset

  ( Event_Id : in Event_Id_Type;
    --| Identifier of event to be cleared
    Status   : out Status_Type
    --| Returned status
  );
  --| Clear Event
  -- ++
  --| Overview:
  --|   This procedure clears the read pipe of the event.
  --| Notes:
  --|   For Linux this is a do nothing procedure since the Event_Wait
  --|   clears the pipe if specified.
  -- --

  procedure Event_Send

  ( Event_Id : in Event_Id_Type;
    --| Identifier of event to be sent
    Status   : out Status_Type
    --| Returned status
  );
  --| Send Event
  -- ++
  --| Overview:
  --|   This procedure writes to the write pipe of the event.
  -- --

  procedure Event_Wait

  ( Event_Id : in Event_Id_Type;
    --| Identifier of event to wait upon
    Clear    : in Boolean := False;
    --| True if to clear the pipe when wait satisfied 
    Time_Out : in Time_Interval_Type := Infinite_Time;
    --| Wait time in which to receive event
    Status   : out Status_Type
    --| Returned status
  );
  --| Wait for Event
  -- ++
  --| Overview:
  --|   This procedure initiates a read of the read pipe for the event.
  --|   It causes the calling thread to be blocked until the event is
  --|   received.  When the pipe read is satisfied, the procedure will
  --|   return to allow the invoking thread to continue.
  --| Notes:
  --|   The read is such that it will empty the pipe thus clearing the
  --|   wakeup event.
  -- --

 end Exec_mC;

The above interface can be used with the exploratory project without the need to modify the referencing code.

package body Exec_mC is

-- ++
--| Notes:
--|   This package body is for use with Linux.
-- --

  --| Notes:

  --|   Events

  type Event_Pair_Type

  --| Pipe pair for read and write
  is ( Wait,   -- read pipe
       Send ); -- write pipe

  type Event_Handle_Type

  is array ( Event_Pair_Type'Range ) of Exec_Itf.Pipe_Handle;

  type Event_Item_Type

  --| Created event info
  is record
    Id     : Event_Id_Type;
    --| Event identifier
    Name   : Event_Name_Type;
    --| Event name (unused with Linux)
    Handle : Event_Handle_Type;
    --| Pair of event pipe handles (i.e., file descriptors)
    --| for read and write
  end record;

The difference from the Windows version is the declarations of the Event_Pair_Type and the Event_Handle_Type and its use to provide two handles rather than one for the event.

  type Event_Array_Type

  --| Created events
  is array ( 1..Event_Id_Type'last ) of Event_Item_Type;

  type Event_List_Type

  --| Created events with count of those created
  is record
    Count : Event_Id_Type;
    --| Number of created events
    List  : Event_Array_Type;
    --| List of created events
  end record;

  Events

  --| Created events
  : Event_List_Type;

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

  procedure Initialize is

  begin -- Initialize

    Events.Count := 0;

  end Initialize;

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

  --| Notes:
  --|   System event interface procedures.

  procedure Event_Create

  ( Event_Name : in Event_Name_Type;
    Event_Id   : out Event_Id_Type;
    Status     : out Status_Type
  ) is
  -- ++
  --| Logic_Flow:
  --|   Check that available table positions exist, open a pair of unnamed
  --|   pipes, store the pipe file descriptors in the table, and return the
  --|   table index as the event identifier.
  -- --

    Result

    --| Create result
    : Integer;

    use type Interfaces.C.Unsigned_Long;

  begin -- Event_Create

    --| Logic_Step:

    --|   Initialize.

    Status   := Not_Available;

    Event_Id := 0;

    if Events.Count < Event_Id_Type'last then

      Events.Count := Events.Count + 1;
    else
      return;
    end if;

    --| Logic_Step:

    --|   Create event.

    Events.List(Events.Count).Id := Events.Count;

    Events.List(Events.Count).Name := Event_Name;
    Result := Exec_Itf.Pipe( Events.List(Events.Count).Handle'address );

    if Result < 0 then

      Events.Count := Events.Count - 1;

      Event_Id := 0;
      Status   := Invalid_Param;

    else

      Event_Id := Events.Count;

      Status   := No_Error;

    end if;

  end Event_Create;

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

  procedure Event_Reset

  ( Event_Id : in Event_Id_Type;
    Status   : out Status_Type
  ) is
  -- ++
  --| Logic_Flow:
  --|   This procedure does nothing except verify the Event_Id for this
  --|   Linux implementation since the pipe clear is done upon wakeup from
  --|   the event wait.
  -- --

  begin -- Event_Reset

    --| Logic_Step:

    --|   Initialize.

    Status := Not_Available;

    --| Logic_Step:

    --|   Reset event.

    if Event_Id > 0 and then

       Event_Id <= Events.Count
    then
      -- for Linux do nothing, pipe cleared upon wakeup from Wait
      Status := No_Error;
    end if;

  end Event_Reset;

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

  procedure Event_Send

  ( Event_Id : in Event_Id_Type;
    Status   : out Status_Type
  ) is
  -- ++
  --| Logic_Flow:
  --|   Check if Event_Id is within range and, if so, write a byte to the
  --|   pipe with its handle at the table location of the Event_Id.
  -- --

    Message

    --| One byte "message" to write to pipe
    : constant Character := ASCII.NUL;

    Written

    --| Number of bytes written
    : Integer := 0;

    function to_FH is new Unchecked_Conversion

                          ( Source => Exec_Itf.Pipe_Handle,
                            Target => Exec_Itf.File_Handle );

  begin -- Event_Send

    --| Logic_Step:

    --|   Initialize.

    Status := Not_Available;

    --| Logic_Step:

    --|   Set Event.

    if Event_Id > 0 and then

       Event_Id <= Events.Count
    then

      Written := Exec_Itf.Write_File -- use write pipe

                 ( to_FH(Events.List(Event_Id).Handle(Send)),
                   Message'address,  -- message to write
                   1 );              -- bytes to write

      if Written = 1 then

        Status := No_Error;
      end if;

    end if;

  end Event_Send;

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

  procedure Event_Wait

  ( Event_Id : in Event_Id_Type;
    Clear    : in Boolean := False;
    Time_Out : in Time_Interval_Type := Infinite_Time;
    Status   : out Status_Type
  ) is
  -- ++
  --| Logic_Flow:
  --|   Check if Event_Id is within range and, if so, read the pipe with
  --|   its handle at the table location of the Event_Id to empty it.  When
  --|   there is something to read, the waiting thread will no longer be
  --|   blocked.
  -- --

    Bytes_Read

    --| Number of bytes read from pipe
    : Integer := -1;

    Bytes_to_Read
    --| Depends upon whether to clear the pipe or not
    : Integer;
  

    Message

    --| Buffer into which to read contents of pipe
    : String(1..512); -- more then enough for a full pipe

--  T_Id

--  : Thread_Id_Type;

    function to_FH is new Unchecked_Conversion

                          ( Source => Exec_Itf.Pipe_Handle,
                            Target => Exec_Itf.File_Handle );

  begin -- Event_Wait

    --| Logic_Step:

    --|   Initialize.

--  My_Thread_Id( Thread_Id => T_Id,

--                Status    => Temp_Status );
--  if Temp_Status /= No_Error then
--    Status := Not_Available;
--    return;
--  end if;

These commented out references are to the current thread and its status and control block.  They will be made active again when the treatment of threads is added back to this package.

    Status := Not_Available;

--  TCB(T_Id).Waiting := On_Event;
--  TCB(T_Id).Status.Thread_State := Waiting;

    --| Logic_Step:

    --|   Wait for Event.

    if Event_Id > 0 and then

       Event_Id <= Events.Count
    then

            Bytes_to_Read := 1;     -- one byte written for each use of Send
      if Clear then
        Bytes_to_Read := 255; -- max possible in pipe to clear it
      end if;

      Bytes_Read := Exec_Itf.Read_File -- use read pipe

                    ( to_FH(Events.List(Event_Id).Handle(Wait)),
                      Message'address, -- read buffer
                      Bytes_to_Read );

      --| Logic_Step:

      --|   Read from pipe has returned.  The wait is complete.

--    TCB(T_Id).Waiting := No_Condition;

--    TCB(T_Id).Status.Thread_State := Running;
--    case Result is
--      when Exec_Itf.WAIT_TIMEOUT =>
--        Status := Timed_Out;
--      when Exec_Itf.WAIT_FAILED  =>
--        null;
--      when Exec_Itf.WAIT_OBJECT_0 =>
--        Status := No_Error;
--      when others =>
--        null; --> will return Not_Available
--    end case;

      if Bytes_Read > 0 then

        Status := No_Error;
      end if;

    end if;

  end Event_Wait;

end Exec_mC;

exec_itf Interface

The Exec_Itf Ada package is another layer that is the immediate interface to the compiler (GNAT) supplied packages and, for Windows, the Win32Ada code.  The code used by the Exec_mC event procedures is shown below as well.  Some file interfaces are also shown since a pipe can be read or written like a file in Linux.  However, not all of these interfaces have been tried.

with GNAT.OS_Lib;

with System;
with Unchecked_Conversion;

package Exec_Itf is

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

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

  procedure Log_Error;

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

  --| 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).

  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.

  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.

  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 Len bytes at Addr to File and return number of bytes written.
  ( File : File_Handle;
    Addr : System.Address;
    Len  : Integer
  ) return Integer;

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

  -- Pipes

  function pipe

  ( Handle : System.Address
  ) return Integer;
  pragma Import( C, pipe, "pipe" );

  type Pipe_Handle is private;

  Invalid_Pipe_Handle

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

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

private

  type File_Handle is new Integer;

  Invalid_File_Handle : constant File_Handle := -1;

  type Pipe_Handle is new Integer;

  Invalid_Pipe_Handle : constant Pipe_Handle := -1;

end Exec_Itf;

 

with Console;
with GNAT.OS_Lib;
with GNAT.Threads;
with Interfaces.C;
with Numeric_Conversion;

package body Exec_Itf is

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

  function Errno return Integer;

  pragma Import (C, Errno, "__get_errno");
  --  Return the task-safe last error number

  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

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

  end Log_Error;

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

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

  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
  --  Open file Name for reading, returning file descriptor File descriptor
  --  returned is Invalid_FD if file cannot be opened.

    Handle : GNAT.OS_Lib.File_Descriptor;

  begin -- Open_Read

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

                                     FMode => to_Mode(Mode) );

    return File_Descriptor_to_Handle( Handle );

  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

  begin -- Read_File

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

                             A  => Addr,
                             N  => Num );

  end Read_File;

  function Write_File

  ( File : File_Handle;
    Addr : System.Address;
    Len  : Integer
  ) return Integer is

  begin -- Write_File

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

                              A  => Addr,
                              N  => Len );

  end Write_File;

end Exec_Itf;