------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUNTIME COMPONENTS                          --
--                                                                          --
--                     S Y S T E M . D I R E C T _ I O                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.6 $                              --
--                                                                          --
--           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
--                                                                          --
-- The GNAT library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU Library General Public License as published by --
-- the Free Software  Foundation; either version 2, or (at your option) any --
-- later version.  The GNAT library 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 --
-- Library  General  Public  License for  more  details.  You  should  have --
-- received  a copy of the GNU  Library  General Public License  along with --
-- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
-- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
--                                                                          --
------------------------------------------------------------------------------

with Ada.IO_Exceptions;         use Ada.IO_Exceptions;
with Interfaces.C_Streams;      use Interfaces.C_Streams;
with System;                    use System;
with System.File_IO;
with System.Tasking_Soft_Links;
with Unchecked_Deallocation;

package body System.Direct_IO is

   package FIO renames System.File_IO;
   subtype AP is FCB.AFCB_Ptr;

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Set_Position (File : in File_Type);
   --  Sets file position pointer according to value of current index

   -------------------
   -- AFCB_Allocate --
   -------------------

   function AFCB_Allocate (Control_Block : Direct_AFCB) return FCB.AFCB_Ptr is
   begin
      return new Direct_AFCB;
   end AFCB_Allocate;

   ----------------
   -- AFCB_Close --
   ----------------

   --  No special processing required for Direct_IO close

   procedure AFCB_Close (File : access Direct_AFCB) is
   begin
      null;
   end AFCB_Close;

   ---------------
   -- AFCB_Free --
   ---------------

   procedure AFCB_Free (File : access Direct_AFCB) is

      type FCB_Ptr is access all Direct_AFCB;

      FT : FCB_Ptr := File;

      procedure Free is new
        Unchecked_Deallocation (Direct_AFCB, FCB_Ptr);

   begin
      Free (FT);
   end AFCB_Free;

   ------------
   -- Create --
   ------------

   procedure Create
     (File : in out File_Type;
      Mode : in FCB.File_Mode := FCB.Inout_File;
      Name : in String := "";
      Form : in String := "")
   is
      File_Control_Block : Direct_AFCB;

   begin
      FIO.Open (File_Ptr  => AP (File),
                Dummy_FCB => File_Control_Block,
                Mode      => Mode,
                Name      => Name,
                Form      => Form,
                Amethod   => 'D',
                Creat     => True,
                Text      => False);
   end Create;

   -----------------
   -- End_Of_File --
   -----------------

   function End_Of_File (File : in File_Type) return Boolean is
   begin
      FIO.Check_Read_Status (AP (File));
      return Count (File.Index) > Size (File);
   end End_Of_File;

   -----------
   -- Index --
   -----------

   function Index (File : in File_Type) return Positive_Count is
   begin
      FIO.Check_File_Open (AP (File));
      return Count (File.Index);
   end Index;

   ----------
   -- Open --
   ----------

   procedure Open
     (File : in out File_Type;
      Mode : in FCB.File_Mode;
      Name : in String;
      Form : in String := "")
   is
      File_Control_Block : Direct_AFCB;

   begin
      FIO.Open (File_Ptr  => AP (File),
                Dummy_FCB => File_Control_Block,
                Mode      => Mode,
                Name      => Name,
                Form      => Form,
                Amethod   => 'D',
                Creat     => False,
                Text      => False);
   end Open;

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

   procedure Read
     (File : in File_Type;
      Item : Address;
      From : in Positive_Count)
   is
   begin
      Set_Index (File, From);
      Read (File, Item);
   end Read;

   procedure Read
     (File : in File_Type;
     Item  : Address)
   is
   begin
      FIO.Check_Read_Status (AP (File));

      --  If last operation was not a read, or if in file sharing mode,
      --  then reset the physical pointer of the file to match the index
      --  We lock out task access over the two operations in this case.

      if File.Last_Op /= Op_Read
        or else File.Shared_Status = FCB.Yes
      then
         if End_Of_File (File) then
            raise End_Error;
         end if;

         System.Tasking_Soft_Links.Lock_Task;
         Set_Position (File);
         FIO.Read_Buf (AP (File), Item, File.Bytes);
         System.Tasking_Soft_Links.Unlock_Task;

      else
         FIO.Read_Buf (AP (File), Item, File.Bytes);
      end if;

      File.Index := File.Index + 1;
      File.Last_Op := Op_Read;
   end Read;

   --  The following is the required overriding for Stream.Read, which is
   --  not used, since we do not do Stream operations on Direct_IO files.

   procedure Read
     (File : in out Direct_AFCB;
      Item : out Ada.Streams.Stream_Element_Array;
      Last : out Ada.Streams.Stream_Element_Offset)
   is
   begin
      raise Program_Error;
   end Read;

   -----------
   -- Reset --
   -----------

   procedure Reset (File : in out File_Type; Mode : in FCB.File_Mode) is
   begin
      FIO.Reset (AP (File), Mode);
      File.Index := 1;
      File.Last_Op := Op_Read;
   end Reset;

   procedure Reset (File : in out File_Type) is
   begin
      FIO.Reset (AP (File));
      File.Index := 1;
      File.Last_Op := Op_Read;
   end Reset;

   ---------------
   -- Set_Index --
   ---------------

   procedure Set_Index (File : in File_Type; To : in Positive_Count) is
   begin
      FIO.Check_File_Open (AP (File));
      File.Index := Count (To);
      File.Last_Op := Op_Other;
   end Set_Index;

   ------------------
   -- Set_Position --
   ------------------

   procedure Set_Position (File : in File_Type) is
   begin
      if fseek
           (File.Stream, long (File.Bytes) *
              long (File.Index - 1), SEEK_SET) /= 0
      then
         raise Use_Error;
      end if;
   end Set_Position;

   ----------
   -- Size --
   ----------

   function Size (File : in File_Type) return Count is
   begin
      FIO.Check_File_Open (AP (File));
      File.Last_Op := Op_Other;

      if fseek (File.Stream, 0, SEEK_END) /= 0 then
         raise Device_Error;
      end if;

      return Positive_Count (ftell (File.Stream) / long (File.Bytes));
   end Size;

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

   procedure Write
     (File : File_Type;
      Item : Address;
      To   : Positive_Count)
   is
   begin
      Set_Index (File, To);
      Write (File, Item);
   end Write;

   procedure Write
     (File : File_Type;
      Item : Address)
   is
   begin
      FIO.Check_Write_Status (AP (File));

      --  If last operation was not a write, or if in file sharing mode,
      --  then reset the physical pointer of the file to match the index
      --  We lock out task access over the two operations in this case.

      if File.Last_Op /= Op_Write
        or else File.Shared_Status = FCB.Yes
      then
         System.Tasking_Soft_Links.Lock_Task;
         Set_Position (File);
         FIO.Write_Buf (AP (File), Item, File.Bytes);
         System.Tasking_Soft_Links.Unlock_Task;
      else
         FIO.Write_Buf (AP (File), Item, File.Bytes);
      end if;

      File.Index := File.Index + 1;
      File.Last_Op := Op_Write;
   end Write;

   --  The following is the required overriding for Stream.Write, which is
   --  not used, since we do not do Stream operations on Direct_IO files.

   procedure Write
     (File : in out Direct_AFCB;
      Item : in Ada.Streams.Stream_Element_Array)
   is
   begin
      raise Program_Error;
   end Write;

end System.Direct_IO;
