File : posix-asynchronous_io.adb


------------------------------------------------------------------------------
--                                                                          --
--            FLORIST (FSU Implementation of POSIX.5) COMPONENTS            --
--                                                                          --
--                 P O S I X . A S Y N C H R O N O U S _ I O                --
--                                                                          --
--                                  B o d y                                 --
--                                                                          --
--                                                                          --
--  Copyright (c)  1996-1998            Florida  State  University  (FSU),  --
--  All Rights Reserved.                                                    --
--                                                                          --
--  This file is a component of FLORIST, an  implementation of an  Ada API  --
--  for the POSIX OS services, for use with  the  GNAT  Ada  compiler  and  --
--  the FSU Gnu Ada Runtime Library (GNARL).   The  interface  is intended  --
--  to be close to that specified in  IEEE STD  1003.5: 1990  and IEEE STD  --
--  1003.5b: 1996.                                                          --
--                                                                          --
--  FLORIST is free software;  you can  redistribute  it and/or  modify it  --
--  under terms of the  GNU  General  Public  License as  published by the  --
--  Free Software Foundation;  either version  2, or (at  your option) any  --
--  later version.  FLORIST is distributed  in  the hope  that  it will be  --
--  useful, but WITHOUT ANY WARRANTY;  without  even the implied  warranty  --
--  of MERCHANTABILITY or FITNESS FOR A PARTICULAR  PURPOSE.  See  the GNU  --
--  General Public License for more details.  You  should have  received a  --
--  copy of the GNU General Public License  distributed  with  GNARL;  see  --
--  file  COPYING.  If not,  write to  the  Free  Software  Foundation, 59  --
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.                   --
--                                                                          --
--  As a special exception, if other files instantiate generics from  this  --
--  unit, or you link this unit with other files to produce an  executable, --
--  this  unit does not by itself cause the  resulting  executable  to  be  --
--  covered  by the  GNU  General  Public License. This exception does not  --
--  however invalidate any other  reasons why the executable file might be  --
--  covered by the GNU Public License.                                      --
--                                                                          --
------------------------------------------------------------------------------
--  [$Revision: 1.1.1.1 $]


with Ada.Streams,
     System,
     POSIX.C,
     POSIX.IO,
     POSIX.Implementation,
     POSIX.Signals,
     Unchecked_Conversion,
     Unchecked_Deallocation;
package body POSIX.Asynchronous_IO is

   use Ada.Streams,
       POSIX.C,
       POSIX.Implementation;

   ---------------------------------
   --  Create_AIO_Control_Block   --
   ---------------------------------

   function Create_AIO_Control_Block return AIO_Descriptor is
   begin
      return new Aiocb_Wrapper;
   end Create_AIO_Control_Block;

   ---------------------------------
   -- Destroy_AIO_Control_Block   --
   ---------------------------------

   function aio_error (AD : AIO_Descriptor) return Error_Code;
   pragma Import (C, aio_error, aio_error_LINKNAME);
   procedure Free is
     new Unchecked_Deallocation (Aiocb_Wrapper, AIO_Descriptor);

   --  ????? Change POSIX.5b?
   --  This operation is very difficult to use correctly, since
   --  it is not idempotent.  That is, if there is an exception and
   --  we want to clean up after it, we cannot safely call Destroy_...
   --  since we don't know whether the AIO_Descriptor is valid.

   procedure Destroy_AIO_Control_Block (AD : in out AIO_Descriptor) is
   begin
      Check (AD /= null, Invalid_Argument);
      if aio_error (AD) = EINPROGRESS then
         Raise_POSIX_Error (Operation_Not_Permitted);
      end if;
      Free (AD);
   end Destroy_AIO_Control_Block;

   ----------------
   --  Get_File  --
   ----------------

   function Get_File (AD : AIO_Descriptor) return POSIX.IO.File_Descriptor is
   begin
      Check (AD /= null, Invalid_Argument);
      return POSIX.IO.File_Descriptor (AD.C.aio_fildes);
   end Get_File;

   ----------------
   --  Set_File  --
   ----------------

   procedure Set_File
     (AD   : in AIO_Descriptor;
      File : in POSIX.IO.File_Descriptor) is
   begin
      Check (AD /= null, Invalid_Argument);
      AD.C.aio_fildes := int (File);
   end Set_File;

   ------------------
   --  Get_Offset  --
   ------------------

   function Get_Offset (AD : AIO_Descriptor) return POSIX.IO.IO_Offset is
   begin
      Check (AD /= null, Invalid_Argument);
      return POSIX.IO.IO_Offset (AD.C.aio_offset);
   end Get_Offset;

   ------------------
   --  Set_Offset  --
   ------------------

   procedure Set_Offset
     (AD     : in AIO_Descriptor;
      Offset : in POSIX.IO.IO_Offset) is
   begin
      Check (AD /= null, Invalid_Argument);
      AD.C.aio_offset := off_t (Offset);
   end Set_Offset;

   ------------------
   --  Get_Buffer  --
   ------------------

   --  .... Change POSIX.5?
   --  The component aio_buf is of type volatile void * in C
   --  The Ada buffer should also be required to be declared volatile.

   function Get_Buffer (AD : AIO_Descriptor) return IO_Array_Pointer is
   begin
      Check (AD /= null, Invalid_Argument);
      return AD.P;
   end Get_Buffer;

   ------------------
   --  Set_Buffer  --
   ------------------

   procedure Set_Buffer
     (AD     : in AIO_Descriptor;
      Buffer : in IO_Array_Pointer) is
   begin
      Check (AD /= null, Invalid_Argument);
      AD.C.aio_nbytes := Buffer'Length;
      AD.C.aio_buf := Buffer (Buffer'First)'Address;
      AD.P := Buffer;
   end Set_Buffer;

   ------------------
   --  Get_Length  --
   ------------------

   function Get_Length (AD : AIO_Descriptor) return IO_Count is
   begin
      Check (AD /= null, Invalid_Argument);
      return IO_Count (AD.C.aio_nbytes);
   end Get_Length;

   ------------------
   --  Set_Length  --
   ------------------

   procedure Set_Length
     (AD     : in AIO_Descriptor;
      Length : in IO_Count) is
   begin
      Check (AD /= null, Invalid_Argument);
      AD.C.aio_nbytes := size_t (Length);
   end Set_Length;

   ------------------------------
   --  Get_Priority_Reduction  --
   ------------------------------

   function Get_Priority_Reduction (AD : AIO_Descriptor) return Natural is
   begin
      Check (AD /= null, Invalid_Argument);
      return Natural (AD.C.aio_reqprio);
   end Get_Priority_Reduction;


   ------------------------------
   --  Set_Priority_Reduction  --
   ------------------------------

   procedure Set_Priority_Reduction
     (AD                 : in AIO_Descriptor;
      Priority_Reduction : in Natural) is
   begin
      Check (AD /= null, Invalid_Argument);
      AD.C.aio_reqprio := int (Priority_Reduction);
   end Set_Priority_Reduction;

   -----------------
   --  Get_Event  --
   -----------------

   function To_Signal_Event is
     new Unchecked_Conversion (struct_sigevent, POSIX.Signals.Signal_Event);

   function Get_Event (AD : AIO_Descriptor)
     return POSIX.Signals.Signal_Event is
   begin
      Check (AD /= null, Invalid_Argument);
      return To_Signal_Event (AD.C.aio_sigevent);
   end Get_Event;

   -----------------
   --  Set_Event  --
   -----------------

   function To_struct_sigevent is
     new Unchecked_Conversion (POSIX.Signals.Signal_Event, struct_sigevent);

   procedure Set_Event
     (AD    : in AIO_Descriptor;
      Event : in POSIX.Signals.Signal_Event) is
   begin
      Check (AD /= null, Invalid_Argument);
      AD.C.aio_sigevent := To_struct_sigevent (Event);
   end Set_Event;

   ---------------------
   --  Get_Operation  --
   ---------------------

   function Get_Operation (AD : AIO_Descriptor) return List_IO_Operations is
      opcode : int;
   begin
      Check (AD /= null, Invalid_Argument);
      opcode := AD.C.aio_lio_opcode;
      if opcode = LIO_NOP then return No_Op;
      elsif opcode = LIO_READ then return Read;
      elsif opcode = LIO_WRITE then return Write;
      end if;
      Raise_POSIX_Error (Invalid_Argument);
      --  to suppress compiler warning message:
      return No_Op;
   end Get_Operation;

   ---------------------
   --  Set_Operation  --
   ---------------------

   C_lio_op : constant array (List_IO_Operations) of int :=
     (No_Op => LIO_NOP,
      Read => LIO_READ,
      Write => LIO_WRITE);

   procedure Set_Operation
     (AD        : in AIO_Descriptor;
      Operation : in List_IO_Operations) is
   begin
      Check (AD /= null, Invalid_Argument);
      AD.C.aio_lio_opcode := C_lio_op (Operation);
   end Set_Operation;

   ------------
   --  Read  --
   ------------

   procedure Read (AD : in AIO_Descriptor) is
      function aio_read (AD : AIO_Descriptor) return int;
      pragma Import (C, aio_read, aio_read_LINKNAME);
   begin
      Check (AD /= null, Invalid_Argument);
      Check (aio_read (AD));
   end Read;

   -------------
   --  Write  --
   -------------

   procedure Write (AD : in AIO_Descriptor) is
      function aio_write (AD : AIO_Descriptor) return int;
      pragma Import (C, aio_write, aio_write_LINKNAME);
   begin
      Check (AD /= null, Invalid_Argument);
      Check (aio_write (AD));
   end Write;

   -----------------------
   --  List_IO_No_Wait  --
   -----------------------

   function lio_listio
     (mode : int;
      list : access AIO_Descriptor;
      nent : int;
      sig  : sigevent_ptr) return int;
   pragma Import (C, lio_listio, lio_listio_LINKNAME);

   procedure List_IO_No_Wait
     (List  : in out AIO_Descriptor_List;
      Event : in POSIX.Signals.Signal_Event) is
      sigevent : aliased struct_sigevent := To_struct_sigevent (Event);
   begin
      for i in List'Range loop
         Check (List (i) /= null, Invalid_Argument);
      end loop;
      Check (lio_listio (LIO_NOWAIT,
        List (List'First)'Unchecked_Access,
        int (List'Length), sigevent'Unchecked_Access));
   end List_IO_No_Wait;

   ---------------------
   --  List_IO_Wait  --
   ---------------------

   procedure List_IO_Wait
     (List           : in out AIO_Descriptor_List;
      Masked_Signals : in POSIX.Signal_Masking := POSIX.RTS_Signals) is
      Old_Mask : aliased Signal_Mask;
      Result : int;
   begin
      for i in List'Range loop
         Check (List (i) /= null, Invalid_Argument);
      end loop;
      Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access);
      Result := lio_listio (LIO_WAIT,
        List (List'First)'Unchecked_Access, int (List'Length), null);
      Check_NNeg_And_Restore_Signals
        (Result, Masked_Signals, Old_Mask'Unchecked_Access);
   end List_IO_Wait;

   ----------------------
   --  Get_AIO_Status  --
   ----------------------

   function Get_AIO_Status (AD : AIO_Descriptor) return AIO_Status is
      Result : Error_Code;
   begin
      Check (AD /= null, Invalid_Argument);
      Result := aio_error (AD);
      if Result = 0 then return Completed_Successfully;
      elsif Result = EINPROGRESS then return In_Progress;
      elsif Result = ECANCELED then return Canceled;
      end if;
      Raise_POSIX_Error;
      --  to supress compiler warning message
      return Canceled;
   end Get_AIO_Status;

   --------------------------
   --  Get_AIO_Error_Code  --
   --------------------------

   function Get_AIO_Error_Code (AD : AIO_Descriptor) return POSIX.Error_Code is
      Result : Error_Code;
   begin
      Check (AD /= null, Invalid_Argument);
      Result := aio_error (AD);
      if Result = ENOSYS or else Result = EINVAL then
         Raise_POSIX_Error;
      end if;
      return Result;
   end Get_AIO_Error_Code;

   -------------------------------
   --  Get_Bytest_Transferred   --
   -------------------------------

   function Get_Bytes_Transferred
     (AD :    AIO_Descriptor) return IO_Count is
      function aio_return (AD : AIO_Descriptor) return ssize_t;
      pragma Import (C, aio_return, aio_return_LINKNAME);
      Result :  ssize_t;
   begin
      Check (AD /= null, Invalid_Argument);
      Result := aio_return (AD);
      Check (int (Result));
      return IO_Count (Result);
   end Get_Bytes_Transferred;

   --------------
   --  Cancel  --
   --------------

   function aio_cancel
     (fildes : int;
      aiocb : AIO_Descriptor) return int;
   pragma Import (C, aio_cancel, aio_cancel_LINKNAME);

   function Cancel (AD : AIO_Descriptor) return Cancelation_Status is
      Result :  int;
   begin
      Result := aio_cancel (AD.C.aio_fildes, AD);
      if Result = AIO_CANCELED then return Canceled;
      elsif Result = AIO_NOTCANCELED then return Not_Canceled;
      elsif Result = AIO_ALLDONE then return All_Done;
      end if;
      Raise_POSIX_Error;
      --  to suppress compiler warning message
      return All_Done;
   end Cancel;

   function Cancel
     (File : POSIX.IO.File_Descriptor) return Cancelation_Status is
      Result : int;
   begin
      Result := aio_cancel (int (File), null);
      if Result = AIO_CANCELED then return Canceled;
      elsif Result = AIO_NOTCANCELED then return Not_Canceled;
      elsif Result = AIO_ALLDONE then return All_Done;
      end if;
      Raise_POSIX_Error;
      --  to suppress compiler warning message
      return All_Done;
   end Cancel;

   ---------------------------
   --  Await_IO_Or_Timeout  --
   ---------------------------

   type aiocb_ptr_ptr is access constant AIO_Descriptor;

   function aio_suspend
     (list    : aiocb_ptr_ptr;
      nent    : int;
      timeout : timespec_ptr) return int;
   pragma Import (C, aio_suspend, aio_suspend_LINKNAME);

   procedure Await_IO_Or_Timeout
     (AD             : in AIO_Descriptor;
      Timeout        : in POSIX.Timespec;
      Masked_Signals : in POSIX.Signal_Masking := POSIX.RTS_Signals) is
      TS : aliased struct_timespec;
      Old_Mask : aliased Signal_Mask;
      List : AIO_Descriptor_List (1 .. 1) := (others => AD);
      Result : int;
   begin
      Check (AD /= null, Invalid_Argument);
      TS := To_Struct_Timespec (To_Duration (Timeout));
      Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access);
      Result := aio_suspend (List (List'First)'Unchecked_Access,
        List'Length, TS'Unchecked_Access);
      Check_NNeg_And_Restore_Signals
        (Result, Masked_Signals, Old_Mask'Unchecked_Access);
   end Await_IO_Or_Timeout;

   procedure Await_IO_Or_Timeout
     (List           : in AIO_Descriptor_List;
      Timeout        : in POSIX.Timespec;
      Masked_Signals : in POSIX.Signal_Masking := POSIX.RTS_Signals) is
      TS : aliased struct_timespec;
      Old_Mask : aliased Signal_Mask;
      Result : int;
   begin
      for i in List'Range loop
         Check (List (i) /= null, Invalid_Argument);
      end loop;
      TS := To_Struct_Timespec (To_Duration (Timeout));
      Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access);
      Result := aio_suspend (List (List'First)'Unchecked_Access,
        List'Length, TS'Unchecked_Access);
      Check_NNeg_And_Restore_Signals
        (Result, Masked_Signals, Old_Mask'Unchecked_Access);
   end Await_IO_Or_Timeout;

   ----------------
   --  Await_IO  --
   ----------------

   procedure Await_IO
     (AD             : in AIO_Descriptor;
      Masked_Signals : in POSIX.Signal_Masking := POSIX.RTS_Signals) is
      Old_Mask : aliased Signal_Mask;
      List : AIO_Descriptor_List (1 .. 1) := (others => AD);
      Result : int;
   begin
      Check (AD /= null, Invalid_Argument);
      Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access);
      Result := aio_suspend (List (List'First)'Unchecked_Access,
        List'Length, null);
      Check_NNeg_And_Restore_Signals
        (Result, Masked_Signals, Old_Mask'Unchecked_Access);
   end Await_IO;

   procedure Await_IO
     (List           : in AIO_Descriptor_List;
      Masked_Signals : in POSIX.Signal_Masking := POSIX.RTS_Signals) is
      Old_Mask : aliased Signal_Mask;
      Result : int;
   begin
      for i in List'Range loop
         if List (i) = null then Raise_POSIX_Error (Invalid_Argument); end if;
      end loop;
      Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access);
      Result := aio_suspend (List (List'First)'Unchecked_Access,
        List'Length, null);
      Check_NNeg_And_Restore_Signals
        (Result, Masked_Signals, Old_Mask'Unchecked_Access);
   end Await_IO;

   ------------------------
   --  Synchronize_File  --
   ------------------------

   function aio_fsync
     (op : int;
      AD : AIO_Descriptor) return int;
   pragma Import (C, aio_fsync, aio_fsync_LINKNAME);

   procedure Synchronize_File (AD : in AIO_Descriptor) is
   begin
      Check (AD /= null, Invalid_Argument);
      Check (aio_fsync (O_SYNC, AD));
   end Synchronize_File;

   ------------------------
   --  Synchronize_Data  --
   ------------------------

   procedure Synchronize_Data (AD : in AIO_Descriptor) is
   begin
      Check (AD /= null, Invalid_Argument);
      Check (aio_fsync (O_DSYNC, AD));
   end Synchronize_Data;

begin
   --  Check that struct aiocb component is allocated in first position,
   --  so that we can safely convert pointers.
   declare
      X : aliased Aiocb_Wrapper;
      use System;
   begin
      if X'Address /= X.C'Address then
         raise Program_Error;
      end if;
   end;
end POSIX.Asynchronous_IO;