with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.CRTL;
with System.File_IO;
with System.Soft_Links;
with Unchecked_Deallocation;
package body System.Direct_IO is
package FIO renames System.File_IO;
package SSL renames System.Soft_Links;
subtype AP is FCB.AFCB_Ptr;
use type FCB.Shared_Status_Type;
use type System.CRTL.long;
use type System.CRTL.size_t;
procedure Set_Position (File : File_Type);
function AFCB_Allocate (Control_Block : Direct_AFCB) return FCB.AFCB_Ptr is
pragma Unreferenced (Control_Block);
begin
return new Direct_AFCB;
end AFCB_Allocate;
procedure AFCB_Close (File : access Direct_AFCB) is
pragma Unreferenced (File);
begin
null;
end AFCB_Close;
procedure AFCB_Free (File : access Direct_AFCB) is
type FCB_Ptr is access all Direct_AFCB;
FT : FCB_Ptr := FCB_Ptr (File);
procedure Free is new
Unchecked_Deallocation (Direct_AFCB, FCB_Ptr);
begin
Free (FT);
end AFCB_Free;
procedure Create
(File : in out File_Type;
Mode : FCB.File_Mode := FCB.Inout_File;
Name : String := "";
Form : String := "")
is
Dummy_File_Control_Block : Direct_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
begin
FIO.Open (File_Ptr => AP (File),
Dummy_FCB => Dummy_File_Control_Block,
Mode => Mode,
Name => Name,
Form => Form,
Amethod => 'D',
Creat => True,
Text => False);
end Create;
function End_Of_File (File : File_Type) return Boolean is
begin
FIO.Check_Read_Status (AP (File));
return Count (File.Index) > Size (File);
end End_Of_File;
function Index (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return Count (File.Index);
end Index;
procedure Open
(File : in out File_Type;
Mode : FCB.File_Mode;
Name : String;
Form : String := "")
is
Dummy_File_Control_Block : Direct_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
begin
FIO.Open (File_Ptr => AP (File),
Dummy_FCB => Dummy_File_Control_Block,
Mode => Mode,
Name => Name,
Form => Form,
Amethod => 'D',
Creat => False,
Text => False);
end Open;
procedure Read
(File : File_Type;
Item : Address;
Size : Interfaces.C_Streams.size_t;
From : Positive_Count)
is
begin
Set_Index (File, From);
Read (File, Item, Size);
end Read;
procedure Read
(File : File_Type;
Item : Address;
Size : Interfaces.C_Streams.size_t)
is
begin
FIO.Check_Read_Status (AP (File));
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;
Locked_Processing : begin
SSL.Lock_Task.all;
Set_Position (File);
FIO.Read_Buf (AP (File), Item, Size);
SSL.Unlock_Task.all;
exception
when others =>
SSL.Unlock_Task.all;
raise;
end Locked_Processing;
else
FIO.Read_Buf (AP (File), Item, Size);
end if;
File.Index := File.Index + 1;
if File.Bytes = Size then
File.Last_Op := Op_Read;
else
File.Last_Op := Op_Other;
end if;
end Read;
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;
procedure Reset (File : in out File_Type; Mode : 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;
procedure Set_Index (File : File_Type; To : Positive_Count) is
begin
FIO.Check_File_Open (AP (File));
File.Index := Count (To);
File.Last_Op := Op_Other;
end Set_Index;
procedure Set_Position (File : 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;
function Size (File : 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 Count (ftell (File.Stream) / long (File.Bytes));
end Size;
procedure Write
(File : File_Type;
Item : Address;
Size : Interfaces.C_Streams.size_t;
Zeroes : System.Storage_Elements.Storage_Array)
is
procedure Do_Write;
procedure Do_Write is
begin
FIO.Write_Buf (AP (File), Item, Size);
if File.Bytes > Size then
FIO.Write_Buf (AP (File), Zeroes'Address, File.Bytes - Size);
end if;
end Do_Write;
begin
FIO.Check_Write_Status (AP (File));
if File.Last_Op /= Op_Write
or else File.Shared_Status = FCB.Yes
then
Locked_Processing : begin
SSL.Lock_Task.all;
Set_Position (File);
Do_Write;
SSL.Unlock_Task.all;
exception
when others =>
SSL.Unlock_Task.all;
raise;
end Locked_Processing;
else
Do_Write;
end if;
File.Index := File.Index + 1;
if File.Bytes = Size then
File.Last_Op := Op_Write;
else
File.Last_Op := Op_Other;
end if;
end Write;
procedure Write
(File : in out Direct_AFCB;
Item : Ada.Streams.Stream_Element_Array)
is
begin
raise Program_Error;
end Write;
end System.Direct_IO;