implemented read/write/read_line/write_line/flush in h2-io-file.adb
This commit is contained in:
parent
d78d6ffa1d
commit
1ac2a37358
@ -6,6 +6,7 @@ with Storage;
|
||||
with Slim_Stream;
|
||||
with Wide_Stream;
|
||||
with Ada.Text_IO;
|
||||
with Ada.Wide_Text_IO;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
|
||||
@ -80,30 +81,45 @@ declare
|
||||
|
||||
package File renames IO.File;
|
||||
|
||||
F: File.File_Record;
|
||||
F, F2: File.File_Record;
|
||||
FL: File.Flag_Record;
|
||||
Buffer: H2.Slim.String (1 .. 10);
|
||||
Length: H2.System_Length;
|
||||
Buffer: H2.Slim.String (1 .. 200);
|
||||
BufferW: H2.Wide.String (1 .. 50);
|
||||
IL, OL: H2.System_Length;
|
||||
begin
|
||||
--File.Open (F, H2.Slim.String'("/etc/passwd"), FL);
|
||||
--File.Read (F, Buffer, Length);
|
||||
--Ada.Text_IO.PUt_Line (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1)));
|
||||
|
||||
--File.Read (F, Buffer, Length);
|
||||
--Ada.Text_IO.PUt_Line (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1)));
|
||||
--Ada.Text_IO.PUt (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1)));
|
||||
--File.Close (F);
|
||||
|
||||
ada.text_io.put_line ("------------------");
|
||||
File.Set_Flag_Bits (FL, File.FLAG_READ);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_NONBLOCK);
|
||||
File.Open (F, H2.Slim.String'("/tmp/xxx"), FL);
|
||||
|
||||
File.Open (F, H2.Slim.String'("/etc/passwd"), FL);
|
||||
File.Clear_Flag_Bits (FL, FL.Bits);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_WRITE);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_CREATE);
|
||||
File.Set_Flag_Bits (FL, File.FLAG_TRUNCATE);
|
||||
File.Open (F2, H2.Wide.String'("/tmp/yyy"), FL);
|
||||
loop
|
||||
File.Read_Line (F, Buffer, Length);
|
||||
if Length <= 0 then
|
||||
exit;
|
||||
end if;
|
||||
Ada.Text_IO.PUt_Line (Standard.String(Buffer(Buffer'First .. Buffer'First + Length - 1)));
|
||||
File.Read (F, Buffer, IL);
|
||||
--File.Read (F, BufferW, IL);
|
||||
exit when IL <= 0;
|
||||
|
||||
File.Write_Line (F2, Buffer(Buffer'First .. Buffer'First + IL - 1), OL);
|
||||
pragma Assert (IL = OL);
|
||||
|
||||
--Ada.Text_IO.PUt (Standard.String(Buffer(Buffer'First .. Buffer'First + IL - 1)));
|
||||
--Ada.Wide_Text_IO.Put_Line (Standard.Wide_String(BufferW(BufferW'First .. BufferW'First + IL - 1)));
|
||||
end loop;
|
||||
|
||||
File.Write (F2, H2.Wide.String'("나는 피리부는 사나이 정말로 멋있는 사나이"), OL);
|
||||
File.Write_Line (F2, H2.Wide.String'("이세상에 문디없어면 무슨재미로 너도 나도 만세."), OL);
|
||||
File.Close (F2);
|
||||
File.Close (F);
|
||||
end;
|
||||
|
||||
|
||||
@ -4,6 +4,40 @@ separate (H2.IO)
|
||||
|
||||
package body File is
|
||||
|
||||
package Slim_Ascii is new H2.Ascii (Slim_Character);
|
||||
package Wide_Ascii is new H2.Ascii (Wide_Character);
|
||||
|
||||
--|-----------------------------------------------------------------------
|
||||
--| PRIVATE ROUTINES
|
||||
--|-----------------------------------------------------------------------
|
||||
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 Shift_Buffer (Buffer: in out File_Buffer;
|
||||
Length: in System_Length) is
|
||||
pragma Inline (Shift_Buffer);
|
||||
begin
|
||||
Buffer.Length := Buffer.Length - Length;
|
||||
Buffer.Data(Buffer.Data'First .. Buffer.Data'First + Buffer.Length - 1) := Buffer.Data(Buffer.Data'First + Length .. Buffer.Data'First + Length + Buffer.Length - 1);
|
||||
end Shift_Buffer;
|
||||
|
||||
procedure Copy_Array (Dst: in out System_Byte_Array;
|
||||
Src: in System_Byte_Array;
|
||||
Length: in System_Length) is
|
||||
pragma Inline (Copy_Array);
|
||||
begin
|
||||
Dst(Dst'First .. Dst'First + Length - 1) := Src(Src'First .. Src'First + Length - 1);
|
||||
end Copy_Array;
|
||||
|
||||
--|-----------------------------------------------------------------------
|
||||
--| OPEN AND CLOSE
|
||||
--|-----------------------------------------------------------------------
|
||||
|
||||
procedure Open (File: in out File_Record;
|
||||
Name: in Slim_String;
|
||||
Flag: in Flag_Record;
|
||||
@ -28,18 +62,14 @@ package body File is
|
||||
|
||||
procedure Close (File: in out File_Record) is
|
||||
begin
|
||||
Flush (File);
|
||||
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;
|
||||
|
||||
--|-----------------------------------------------------------------------
|
||||
--| READ SLIM STRING
|
||||
--|-----------------------------------------------------------------------
|
||||
procedure Read (File: in out File_Record;
|
||||
Buffer: in out Slim_String;
|
||||
Length: out System_Length) is
|
||||
@ -68,7 +98,7 @@ package body File is
|
||||
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);
|
||||
Copy_Array (Outbuf, Rbuf.Data, L1);
|
||||
|
||||
-- Empty the internal buffer.
|
||||
Rbuf.Length := 0;
|
||||
@ -90,77 +120,14 @@ package body File is
|
||||
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);
|
||||
Copy_Array (Outbuf, Rbuf.Data, L2);
|
||||
|
||||
-- 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);
|
||||
Shift_Buffer (Rbuf, L2);
|
||||
|
||||
-- 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;
|
||||
@ -175,7 +142,6 @@ package body File is
|
||||
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
|
||||
@ -196,22 +162,18 @@ package body File is
|
||||
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;
|
||||
exit when Rbuf.Length <= 0;
|
||||
|
||||
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
|
||||
if K >= Outbuf'Last or else Outbuf(K) = Slim_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
|
||||
Shift_Buffer (Rbuf, L1); -- Shift the residue
|
||||
exit outer; -- Done
|
||||
end if;
|
||||
end loop;
|
||||
@ -223,30 +185,309 @@ package body File is
|
||||
Length := K + 1 - Outbuf'First;
|
||||
end Read_Line;
|
||||
|
||||
--|-----------------------------------------------------------------------
|
||||
--| READ WIDE STRING
|
||||
--|-----------------------------------------------------------------------
|
||||
procedure Read_Wide (File: in out File_Record;
|
||||
Buffer: in out Wide_String;
|
||||
Length: out System_Length;
|
||||
Terminator: in Wide_String) 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, L4, 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: while K < Outbuf'Last 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);
|
||||
Rbuf.Length := Rbuf.Length + L1;
|
||||
end if;
|
||||
|
||||
exit when Rbuf.Length <= 0;
|
||||
|
||||
L2 := Rbuf.Data'First + Rbuf.Length - 1; -- Last index of the internal buffer
|
||||
I := Rbuf.Data'First;
|
||||
while I <= L2 and K < Outbuf'Last loop
|
||||
L3 := Sequence_Length(Inbuf(I)); -- Required number of bytes to compose a wide character
|
||||
|
||||
if L3 <= 0 then
|
||||
-- Potentially illegal sequence
|
||||
K := K + 1;
|
||||
Outbuf(K) := Wide_Ascii.Question;
|
||||
I := I + 1;
|
||||
else
|
||||
L4 := L2 - I + 1; -- Avaliable number of bytes available in the internal buffer
|
||||
if L4 < L3 then
|
||||
-- Insufficient data available. Exit the inner loop to read more.
|
||||
exit;
|
||||
end if;
|
||||
|
||||
K := K + 1;
|
||||
J := I + L3;
|
||||
begin
|
||||
Outbuf(K..K) := Slim_To_Wide(Inbuf(I .. J - 1));
|
||||
exception
|
||||
when others =>
|
||||
Outbuf(K) := Wide_Ascii.Question;
|
||||
J := I + 1; -- Override J to skip 1 byte only
|
||||
end;
|
||||
I := J;
|
||||
end if;
|
||||
|
||||
if Terminator'Length > 0 and then
|
||||
Outbuf(K) = Terminator(Terminator'First) then
|
||||
-- TODO: compare more characters in terminator, not just the first charactrer
|
||||
Shift_Buffer (Rbuf, I - Rbuf.Data'First);
|
||||
exit outer;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- Move the residue to the front.
|
||||
Shift_Buffer (Rbuf, I - Rbuf.Data'First);
|
||||
end loop outer;
|
||||
|
||||
Length := K + 1 - Outbuf'First;
|
||||
end Read_Wide;
|
||||
|
||||
procedure Read (File: in out File_Record;
|
||||
Buffer: in out Wide_String;
|
||||
Length: out System_Length) is
|
||||
Terminator: Wide_String(1..0);
|
||||
begin
|
||||
Read_Wide (File, Buffer, Length, Terminator);
|
||||
end Read;
|
||||
|
||||
procedure Read_Line (File: in out File_Record;
|
||||
Buffer: in out Wide_String;
|
||||
Length: out System_Length) is
|
||||
Terminator: constant Wide_String(1..1) := (1 => Wide_Ascii.LF);
|
||||
begin
|
||||
null;
|
||||
Read_Wide (File, Buffer, Length, Terminator);
|
||||
end Read_Line;
|
||||
|
||||
--|-----------------------------------------------------------------------
|
||||
--| WRITE SLIM STRING
|
||||
--|-----------------------------------------------------------------------
|
||||
procedure Write (File: in out File_Record;
|
||||
Buffer: in Slim_String;
|
||||
Length: out System_Length) is
|
||||
Wbuf: File_Buffer renames File.Wbuf;
|
||||
|
||||
Inbuf: System_Byte_Array (Buffer'Range);
|
||||
for Inbuf'Address use Buffer'Address;
|
||||
|
||||
F, L: System_Length;
|
||||
begin
|
||||
null;
|
||||
-- This procedure attempts to write as many bytes as requested.
|
||||
-- However, under a certain condition, it may not be able to
|
||||
-- process the input buffer in full.
|
||||
|
||||
if Wbuf.Length > 0 then
|
||||
-- Some residue data in the internal buffer.
|
||||
|
||||
if Inbuf'Length <= Wbuf.Data'Length - Wbuf.Length then
|
||||
-- Copy the input to the internal buffer to reduce OS calls
|
||||
F := Wbuf.Data'First + Wbuf.Length - 1;
|
||||
L := F + Inbuf'Length - 1;
|
||||
Wbuf.Data(F .. L) := Inbuf;
|
||||
Flush (File);
|
||||
|
||||
Length := Inbuf'Length;
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Flush the residue first.
|
||||
Flush (File);
|
||||
end if;
|
||||
|
||||
L := 0;
|
||||
while L < Inbuf'Length loop
|
||||
--begin
|
||||
OS.File.Write (File.File, Inbuf, F);
|
||||
--exception
|
||||
-- when OS.Would_Block_Exception =>
|
||||
-- -- Cannot write the input in full.
|
||||
-- -- Copy some to to the internal buffer
|
||||
-- L := L + as much as copied;
|
||||
-- exit;
|
||||
-- when others =>
|
||||
-- raise;
|
||||
--end;
|
||||
L := L + F;
|
||||
end loop;
|
||||
|
||||
Length := L;
|
||||
end Write;
|
||||
|
||||
procedure Write_Line (File: in out File_Record;
|
||||
Buffer: in Slim_String;
|
||||
Length: out System_Length) is
|
||||
Wbuf: File_Buffer renames File.Wbuf;
|
||||
|
||||
Inbuf: System_Byte_Array (Buffer'Range);
|
||||
for Inbuf'Address use Buffer'Address;
|
||||
|
||||
I, J, LF: System_Length;
|
||||
|
||||
begin
|
||||
-- This procedure attempts to write the input up to the last line
|
||||
-- terminator. It buffers the remaining input after the terminator.
|
||||
-- The input may not include any line terminators.
|
||||
|
||||
LF := Wbuf.Data'First - 1;
|
||||
I := Inbuf'First - 1;
|
||||
while I < Inbuf'Last loop
|
||||
I := I + 1;
|
||||
J := Wbuf.Data'First + Wbuf.Length;
|
||||
Wbuf.Data(J) := Inbuf(I);
|
||||
Wbuf.Length := Wbuf.Length + 1;
|
||||
if Wbuf.Data(J) = Slim_Ascii.Pos.LF then -- TODO: different line terminator
|
||||
-- Remeber the index of the line terminator
|
||||
LF := J;
|
||||
end if;
|
||||
|
||||
if Wbuf.Length >= Wbuf.Data'Length then
|
||||
-- The internal write buffer is full.
|
||||
Flush (File);
|
||||
LF := Wbuf.Data'First - 1;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- The line terminator was found. Write up to the terminator.
|
||||
-- Keep the rest in the internal buffer.
|
||||
while LF in Wbuf.Data'First .. Wbuf.Length loop
|
||||
OS.File.Write (File.File, Wbuf.Data(Wbuf.Data'First .. LF), J);
|
||||
Shift_Buffer (Wbuf, J);
|
||||
LF := LF - J;
|
||||
end loop;
|
||||
|
||||
Length := I - Inbuf'First + 1;
|
||||
end Write_Line;
|
||||
|
||||
--|-----------------------------------------------------------------------
|
||||
--| WRITE WIDE STRING
|
||||
--|-----------------------------------------------------------------------
|
||||
procedure Write (File: in out File_Record;
|
||||
Buffer: in Wide_String;
|
||||
Length: out System_Length) is
|
||||
Wbuf: File_Buffer renames File.Wbuf;
|
||||
F, L, I: System_Length;
|
||||
begin
|
||||
null;
|
||||
I := Buffer'First - 1;
|
||||
while I < Buffer'Last loop
|
||||
I := I + 1;
|
||||
declare
|
||||
Tmp: Slim_String := Wide_To_Slim(Buffer(I..I));
|
||||
Tmp2: System_Byte_Array(Tmp'Range);
|
||||
for Tmp2'Address use Tmp'Address;
|
||||
begin
|
||||
F := Wbuf.Data'First + Wbuf.Length;
|
||||
L := F + Tmp2'Length - 1;
|
||||
|
||||
if L > Wbuf.Data'Last then
|
||||
-- The multi-byte sequence for the current character
|
||||
-- can't fit into the internal buffer. Flush the
|
||||
-- buffer and attempt to fit it in.
|
||||
Flush (File);
|
||||
F := Wbuf.Data'First;
|
||||
L := F + Tmp2'Length - 1;
|
||||
end if;
|
||||
|
||||
Wbuf.Data(F..L) := Tmp2;
|
||||
Wbuf.Length := Wbuf.Length + Tmp2'Length;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
Flush (File);
|
||||
Length := I - Buffer'First + 1;
|
||||
end Write;
|
||||
|
||||
procedure Flush (File: in out File_Record) is
|
||||
procedure Write_Line (File: in out File_Record;
|
||||
Buffer: in Wide_String;
|
||||
Length: out System_Length) is
|
||||
|
||||
Wbuf: File_Buffer renames File.Wbuf;
|
||||
F, L, I, LF: System_Length;
|
||||
begin
|
||||
null;
|
||||
LF := Wbuf.Data'First - 1;
|
||||
I := Buffer'First - 1;
|
||||
while I < Buffer'Last loop
|
||||
I := I + 1;
|
||||
declare
|
||||
Tmp: Slim_String := Wide_To_Slim(Buffer(I..I));
|
||||
Tmp2: System_Byte_Array(Tmp'Range);
|
||||
for Tmp2'Address use Tmp'Address;
|
||||
begin
|
||||
F := Wbuf.Data'First + Wbuf.Length;
|
||||
L := F + Tmp2'Length - 1;
|
||||
|
||||
if L > Wbuf.Data'Last then
|
||||
-- The multi-byte sequence for the current character
|
||||
-- can't fit into the internal buffer. Flush the
|
||||
-- buffer and attempt to fit it in.
|
||||
Flush (File);
|
||||
F := Wbuf.Data'First;
|
||||
L := F + Tmp2'Length - 1;
|
||||
LF := Wbuf.Data'First - 1;
|
||||
end if;
|
||||
|
||||
Wbuf.Data(F..L) := Tmp2;
|
||||
Wbuf.Length := Wbuf.Length + Tmp2'Length;
|
||||
|
||||
if Buffer(I) = Wide_Ascii.LF then -- TODO: different line terminator
|
||||
LF := L;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
-- The line terminator was found. Write up to the terminator.
|
||||
-- Keep the rest in the internal buffer.
|
||||
while LF in Wbuf.Data'First .. Wbuf.Length loop
|
||||
OS.File.Write (File.File, Wbuf.Data(Wbuf.Data'First .. LF), L);
|
||||
Shift_Buffer (Wbuf, L);
|
||||
LF := LF - L;
|
||||
end loop;
|
||||
|
||||
Length := I - Buffer'First + 1;
|
||||
end Write_Line;
|
||||
|
||||
--|-----------------------------------------------------------------------
|
||||
--| FLUSH AND DRAIN
|
||||
--|-----------------------------------------------------------------------
|
||||
procedure Flush (File: in out File_Record) is
|
||||
Wbuf: File_Buffer renames File.Wbuf;
|
||||
Length: System_Length;
|
||||
begin
|
||||
while Wbuf.Length > 0 loop
|
||||
--begin
|
||||
OS.File.Write (File.File, Wbuf.Data(Wbuf.Data'First .. Wbuf.Length), Length);
|
||||
--exception
|
||||
-- when Would_Block_Exception =>
|
||||
-- -- Flush must write all it can.
|
||||
-- null;
|
||||
-- when others =>
|
||||
-- raise;
|
||||
--end;
|
||||
Shift_Buffer (Wbuf, Length);
|
||||
end loop;
|
||||
end Flush;
|
||||
|
||||
procedure Drain (File: in out File_Record) is
|
||||
begin
|
||||
File.Wbuf.Length := 0;
|
||||
end Drain;
|
||||
end File;
|
||||
|
||||
@ -54,14 +54,14 @@ package H2.IO is
|
||||
Buffer: in out Slim_String;
|
||||
Length: out System_Length);
|
||||
|
||||
procedure Read (File: in out File_Record;
|
||||
Buffer: in out Wide_String;
|
||||
Length: out System_Length);
|
||||
|
||||
procedure Read_Line (File: in out File_Record;
|
||||
Buffer: in out Slim_String;
|
||||
Length: out System_Length);
|
||||
|
||||
procedure Read (File: in out File_Record;
|
||||
Buffer: in out Wide_String;
|
||||
Length: out System_Length);
|
||||
|
||||
procedure Read_Line (File: in out File_Record;
|
||||
Buffer: in out Wide_String;
|
||||
Length: out System_Length);
|
||||
@ -70,15 +70,35 @@ package H2.IO is
|
||||
Buffer: in Slim_String;
|
||||
Length: out System_Length);
|
||||
|
||||
-- The Write_Line procedure doesn't add a line terminator.
|
||||
-- It writes to the underlying file if the internal buffer
|
||||
-- is full or writes up to the last line terminator found.
|
||||
procedure Write_Line (File: in out File_Record;
|
||||
Buffer: in Slim_String;
|
||||
Length: out System_Length);
|
||||
|
||||
procedure Write (File: in out File_Record;
|
||||
Buffer: in Wide_String;
|
||||
Length: out System_Length);
|
||||
|
||||
procedure Write_Line (File: in out File_Record;
|
||||
Buffer: in Wide_String;
|
||||
Length: out System_Length);
|
||||
|
||||
|
||||
procedure Flush (File: in out File_Record);
|
||||
procedure Drain (File: in out File_Record);
|
||||
|
||||
--procedure Rewind (File: in out File_Record);
|
||||
--procedure Set_Position (File: in out File_Record; Position: Position_Record);
|
||||
--procedure Get_Position (File: in out File_Record; Position: Position_Record);
|
||||
|
||||
private
|
||||
type File_Buffer is record
|
||||
Data: System_Byte_Array (1 .. 2048); -- TODO: determine the best size
|
||||
-- TODO: determine the best buffer size.
|
||||
-- The Data array size must be as large as the longest
|
||||
-- multi-byte sequence for a single wide character.
|
||||
Data: System_Byte_Array (1 .. 2048);
|
||||
Length: System_Length := 0;
|
||||
end record;
|
||||
|
||||
|
||||
@ -9,8 +9,6 @@ generic
|
||||
|
||||
package H2.OS is
|
||||
|
||||
|
||||
|
||||
type File_Flag_Bits is new System_Word;
|
||||
type File_Flag_Record is record
|
||||
Bits: File_Flag_Bits := 0;
|
||||
@ -98,6 +96,11 @@ package H2.OS is
|
||||
pragma Inline (Get_Stderr);
|
||||
end File;
|
||||
|
||||
--package Socket
|
||||
-- type Socket_Record is tagged null record;
|
||||
-- type Socket_Pointer is access all Socket_Record'Class;
|
||||
--end Socket;
|
||||
|
||||
--procedure Open_File (File: out File_Pointer;
|
||||
-- Flag: in Flag_Record;
|
||||
-- Mode: in Mode_Record) renames File.Open;
|
||||
|
||||
@ -47,15 +47,23 @@ package body File is
|
||||
V := V or Sysdef.O_RDONLY;
|
||||
end if;
|
||||
|
||||
if ((Bits and FLAG_CREATE) /= 0) then
|
||||
if (Bits and FLAG_CREATE) /= 0 then
|
||||
V := V or Sysdef.O_CREAT;
|
||||
end if;
|
||||
|
||||
if ((Bits and FLAG_TRUNCATE) /= 0) then
|
||||
if (Bits and FLAG_TRUNCATE) /= 0 then
|
||||
V := V or Sysdef.O_TRUNC;
|
||||
end if;
|
||||
|
||||
if ((Bits and FLAG_SYNC) /= 0) then
|
||||
if (Bits and FLAG_APPEND) /= 0 then
|
||||
V := V or Sysdef.O_APPEND;
|
||||
end if;
|
||||
|
||||
if (Bits and FLAG_NONBLOCK) /= 0 then
|
||||
V := V or Sysdef.O_NONBLOCK;
|
||||
end if;
|
||||
|
||||
if (Bits and FLAG_SYNC) /= 0 then
|
||||
V := V or Sysdef.O_SYNC;
|
||||
end if;
|
||||
|
||||
|
||||
@ -32,6 +32,12 @@ int main (int argc, char* argv[])
|
||||
printf ("\tO_CREAT: constant := %d;\n", O_CREAT);
|
||||
printf ("\tO_EXCL: constant := %d;\n", O_EXCL);
|
||||
printf ("\tO_TRUNC: constant := %d;\n", O_TRUNC);
|
||||
printf ("\tO_APPEND: constant := %d;\n", O_APPEND);
|
||||
|
||||
#if !defined(O_NONBLOCK)
|
||||
# define O_NONBLOCK 0
|
||||
#endif
|
||||
printf ("\tO_NONBLOCK: constant := %d;\n", O_NONBLOCK);
|
||||
|
||||
#if !defined(O_SYNC)
|
||||
# define O_SYNC 0
|
||||
|
||||
Loading…
Reference in New Issue
Block a user