253 lines
7.2 KiB
Ada
253 lines
7.2 KiB
Ada
with H2.Ascii;
|
|
|
|
separate (H2.IO)
|
|
|
|
package body File is
|
|
|
|
procedure Open (File: in out File_Record;
|
|
Name: in Slim_String;
|
|
Flag: in Flag_Record;
|
|
Pool: in Storage_Pool_Pointer := null) is
|
|
begin
|
|
OS.File.Open (File.File, Name, Flag, Pool => Pool);
|
|
File.Rbuf.Length := 0;
|
|
File.Wbuf.Length := 0;
|
|
File.EOF := Standard.False;
|
|
end Open;
|
|
|
|
procedure Open (File: in out File_Record;
|
|
Name: in Wide_String;
|
|
Flag: in Flag_Record;
|
|
Pool: in Storage_Pool_Pointer := null) is
|
|
begin
|
|
OS.File.Open (File.File, Name, Flag, Pool => Pool);
|
|
File.Rbuf.Length := 0;
|
|
File.Wbuf.Length := 0;
|
|
File.EOF := Standard.False;
|
|
end Open;
|
|
|
|
procedure Close (File: in out File_Record) is
|
|
begin
|
|
OS.File.Close (File.File);
|
|
File.File := null;
|
|
end Close;
|
|
|
|
procedure OS_Read_File (File: in out File_Record;
|
|
Buffer: in out System_Byte_Array;
|
|
Length: out System_Length) is
|
|
begin
|
|
OS.File.Read (File.File, Buffer, Length);
|
|
File.EOF := (Length <= 0);
|
|
end OS_Read_File;
|
|
|
|
procedure Read (File: in out File_Record;
|
|
Buffer: in out Slim_String;
|
|
Length: out System_Length) is
|
|
pragma Assert (Buffer'Length > 0);
|
|
|
|
Outbuf: System_Byte_Array (Buffer'Range);
|
|
for Outbuf'Address use Buffer'Address;
|
|
|
|
Rbuf: File_Buffer renames File.Rbuf;
|
|
L1, L2: System_Length;
|
|
begin
|
|
if Rbuf.Length <= 0 and then File.EOF then
|
|
-- raise EOF EXCEPTION. ???
|
|
Length := 0;
|
|
return;
|
|
end if;
|
|
|
|
if Outbuf'Length >= Rbuf.Data'Length then
|
|
-- The output buffer size if greater than the internal buffer size.
|
|
|
|
L1 := Rbuf.Length;
|
|
if L1 < Outbuf'Length then
|
|
-- Read into the tail of the output buffer if insufficient
|
|
-- data is available in the internal buffer.
|
|
OS_Read_File (File, Outbuf(Outbuf'First + L1 .. Outbuf'Last), L2);
|
|
end if;
|
|
|
|
-- Fill the head of the output buffer with the internal buffer contents
|
|
Outbuf(Outbuf'First .. Outbuf'First + L1 - 1) := Rbuf.Data(Rbuf.Data'First .. Rbuf.Data'First + L1 - 1);
|
|
|
|
-- Empty the internal buffer.
|
|
Rbuf.Length := 0;
|
|
|
|
-- Set the output length
|
|
Length := L1 + L2;
|
|
else
|
|
if Rbuf.Length < Rbuf.Data'Length then
|
|
-- Attempt to fill the internal buffer. It may not get full with a single read.
|
|
OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1);
|
|
Rbuf.Length := RBuf.Length + L1;
|
|
end if;
|
|
|
|
-- Determine how much need to be copied to the output buffer.
|
|
If Outbuf'Length < Rbuf.Length then
|
|
L2 := Outbuf'Length;
|
|
else
|
|
L2 := Rbuf.Length;
|
|
end if;
|
|
|
|
-- Copy the head of the internal buffer to the output buffer
|
|
Outbuf(Outbuf'First .. Outbuf'First + L2 - 1) := Rbuf.Data(Rbuf.Data'First .. Rbuf.Data'First + L2 - 1);
|
|
|
|
-- Move the residue of the internal buffer to the head
|
|
Rbuf.Length := Rbuf.Length - L2;
|
|
Rbuf.Data(Rbuf.Data'First .. Rbuf.Data'First + Rbuf.Length - 1) := Rbuf.Data(Rbuf.Data'First + L2 .. Rbuf.Data'First + L2 + Rbuf.Length - 1);
|
|
|
|
-- Set the output length
|
|
Length := L2;
|
|
end if;
|
|
|
|
end Read;
|
|
|
|
procedure Read (File: in out File_Record;
|
|
Buffer: in out Wide_String;
|
|
Length: out System_Length) is
|
|
pragma Assert (Buffer'Length > 0);
|
|
Outbuf: Wide_String renames Buffer;
|
|
|
|
Rbuf: File_Buffer renames File.Rbuf;
|
|
Inbuf: Slim_String (Rbuf.Data'Range);
|
|
for Inbuf'Address use Rbuf.Data'Address;
|
|
|
|
L1, L2, L3, I, J, K: System_Length;
|
|
|
|
begin
|
|
if Rbuf.Length <= 0 and then File.EOF then
|
|
-- raise EOF EXCEPTION. ???
|
|
Length := 0;
|
|
return;
|
|
end if;
|
|
|
|
K := Outbuf'First - 1;
|
|
|
|
outer: loop
|
|
if Rbuf.Length < Rbuf.Data'Length then
|
|
-- Attempt to fill the internal buffer. It may not get full with a single read.
|
|
OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1);
|
|
File.EOF := (L1 <= 0);
|
|
Rbuf.Length := Rbuf.Length + L1;
|
|
end if;
|
|
|
|
if Rbuf.Length <= 0 then
|
|
exit outer;
|
|
end if;
|
|
|
|
L2 := Rbuf.Data'First + Rbuf.Length - 1; -- Last index of the internal buffer
|
|
I := Rbuf.Data'First;
|
|
loop
|
|
L3 := Sequence_Length (Inbuf(I));
|
|
if L2 - I + 1 < L3 then
|
|
exit;
|
|
end if;
|
|
|
|
K := K + 1;
|
|
J := I + L3;
|
|
Outbuf(K..K) := Slim_To_Wide(Inbuf(I .. J - 1));
|
|
I := J;
|
|
|
|
--if K >= Outbuf'Last or else Outbuf(K) = Ascii.Pos.LF then -- TODO: different line terminator
|
|
-- L1 := I - Rbuf.Data'First + 1; -- Length of data copied to the output buffer.
|
|
-- Rbuf.Length := Rbuf.Length - L1; -- Residue length
|
|
-- Rbuf.Data(Rbuf.Data'First .. RBuf.Data'First + Rbuf.Length - 1) := Rbuf.Data(I + 1 .. L2); -- Copy residue
|
|
-- exit outer; -- Done
|
|
--end if;
|
|
end loop;
|
|
|
|
-- Empty the internal buffer;
|
|
Rbuf.Length := 0;
|
|
end loop outer;
|
|
|
|
Length := K + 1 - Outbuf'First;
|
|
end Read;
|
|
|
|
procedure Read_Line (File: in out File_Record;
|
|
Buffer: in out Slim_String;
|
|
Length: out System_Length) is
|
|
|
|
pragma Assert (Buffer'Length > 0);
|
|
|
|
Outbuf: System_Byte_Array (Buffer'Range);
|
|
for Outbuf'Address use Buffer'Address;
|
|
|
|
Rbuf: File_Buffer renames File.Rbuf;
|
|
L1, L2, K: System_Length;
|
|
|
|
package Ascii is new H2.Ascii (Slim_Character);
|
|
begin
|
|
-- Unlike Read, this procedure should use the internal buffer
|
|
-- regardless of the output buffer size as the position of
|
|
-- the line terminator is unknown.
|
|
--
|
|
-- If the buffer is not large enough to hold a line, the output
|
|
-- is just truncated truncated to the buffer size.
|
|
|
|
if Rbuf.Length <= 0 and then File.EOF then
|
|
-- raise EOF EXCEPTION. ???
|
|
Length := 0;
|
|
return;
|
|
end if;
|
|
|
|
K := Outbuf'First - 1;
|
|
|
|
outer: loop
|
|
if Rbuf.Length < Rbuf.Data'Length then
|
|
-- Attempt to fill the internal buffer. It may not get full with a single read.
|
|
OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1);
|
|
File.EOF := (L1 <= 0);
|
|
Rbuf.Length := Rbuf.Length + L1;
|
|
end if;
|
|
|
|
if Rbuf.Length <= 0 then
|
|
exit outer;
|
|
end if;
|
|
|
|
L2 := Rbuf.Data'First + Rbuf.Length - 1; -- Last index of the internal buffer
|
|
for I in Rbuf.Data'First .. L2 loop
|
|
K := K + 1;
|
|
Outbuf(K) := Rbuf.Data(I);
|
|
if K >= Outbuf'Last or else Outbuf(K) = Ascii.Pos.LF then -- TODO: different line terminator
|
|
L1 := I - Rbuf.Data'First + 1; -- Length of data copied to the output buffer.
|
|
Rbuf.Length := Rbuf.Length - L1; -- Residue length
|
|
Rbuf.Data(Rbuf.Data'First .. RBuf.Data'First + Rbuf.Length - 1) := Rbuf.Data(I + 1 .. L2); -- Copy residue
|
|
exit outer; -- Done
|
|
end if;
|
|
end loop;
|
|
|
|
-- Empty the internal buffer;
|
|
Rbuf.Length := 0;
|
|
end loop outer;
|
|
|
|
Length := K + 1 - Outbuf'First;
|
|
end Read_Line;
|
|
|
|
procedure Read_Line (File: in out File_Record;
|
|
Buffer: in out Wide_String;
|
|
Length: out System_Length) is
|
|
begin
|
|
null;
|
|
end Read_Line;
|
|
|
|
procedure Write (File: in out File_Record;
|
|
Buffer: in Slim_String;
|
|
Length: out System_Length) is
|
|
begin
|
|
null;
|
|
end Write;
|
|
|
|
procedure Write (File: in out File_Record;
|
|
Buffer: in Wide_String;
|
|
Length: out System_Length) is
|
|
begin
|
|
null;
|
|
end Write;
|
|
|
|
procedure Flush (File: in out File_Record) is
|
|
begin
|
|
null;
|
|
end Flush;
|
|
|
|
end File;
|