added Get_Line into h2-io-file
This commit is contained in:
parent
1ac2a37358
commit
b441709a02
@ -8,7 +8,7 @@ with Wide_Stream;
|
|||||||
with Ada.Text_IO;
|
with Ada.Text_IO;
|
||||||
with Ada.Wide_Text_IO;
|
with Ada.Wide_Text_IO;
|
||||||
with Ada.Unchecked_Deallocation;
|
with Ada.Unchecked_Deallocation;
|
||||||
|
with Ada.Exceptions;
|
||||||
|
|
||||||
with H2.OS;
|
with H2.OS;
|
||||||
with H2.IO;
|
with H2.IO;
|
||||||
@ -84,7 +84,7 @@ declare
|
|||||||
F, F2: File.File_Record;
|
F, F2: File.File_Record;
|
||||||
FL: File.Flag_Record;
|
FL: File.Flag_Record;
|
||||||
Buffer: H2.Slim.String (1 .. 200);
|
Buffer: H2.Slim.String (1 .. 200);
|
||||||
BufferW: H2.Wide.String (1 .. 50);
|
BufferW: H2.Wide.String (1 .. 27);
|
||||||
IL, OL: H2.System_Length;
|
IL, OL: H2.System_Length;
|
||||||
begin
|
begin
|
||||||
--File.Open (F, H2.Slim.String'("/etc/passwd"), FL);
|
--File.Open (F, H2.Slim.String'("/etc/passwd"), FL);
|
||||||
@ -96,6 +96,12 @@ begin
|
|||||||
--File.Close (F);
|
--File.Close (F);
|
||||||
|
|
||||||
ada.text_io.put_line ("------------------");
|
ada.text_io.put_line ("------------------");
|
||||||
|
|
||||||
|
|
||||||
|
--Stdout.Get_Line (..
|
||||||
|
--Stdout.Print ("-----------------");
|
||||||
|
--Stdout.Print_Line ("-------------------");
|
||||||
|
|
||||||
File.Set_Flag_Bits (FL, File.FLAG_READ);
|
File.Set_Flag_Bits (FL, File.FLAG_READ);
|
||||||
File.Set_Flag_Bits (FL, File.FLAG_NONBLOCK);
|
File.Set_Flag_Bits (FL, File.FLAG_NONBLOCK);
|
||||||
File.Open (F, H2.Slim.String'("/tmp/xxx"), FL);
|
File.Open (F, H2.Slim.String'("/tmp/xxx"), FL);
|
||||||
@ -105,12 +111,16 @@ ada.text_io.put_line ("------------------");
|
|||||||
File.Set_Flag_Bits (FL, File.FLAG_CREATE);
|
File.Set_Flag_Bits (FL, File.FLAG_CREATE);
|
||||||
File.Set_Flag_Bits (FL, File.FLAG_TRUNCATE);
|
File.Set_Flag_Bits (FL, File.FLAG_TRUNCATE);
|
||||||
File.Open (F2, H2.Wide.String'("/tmp/yyy"), FL);
|
File.Open (F2, H2.Wide.String'("/tmp/yyy"), FL);
|
||||||
|
|
||||||
loop
|
loop
|
||||||
File.Read (F, Buffer, IL);
|
|
||||||
|
File.Get_Line (F, BufferW, IL);
|
||||||
|
|
||||||
|
ada.wide_text_io.put_line (standard.wide_string(bufferw(1..il)));
|
||||||
--File.Read (F, BufferW, IL);
|
--File.Read (F, BufferW, IL);
|
||||||
exit when IL <= 0;
|
exit when IL <= 0;
|
||||||
|
|
||||||
File.Write_Line (F2, Buffer(Buffer'First .. Buffer'First + IL - 1), OL);
|
File.Write_Line (F2, BufferW(BufferW'First .. BufferW'First + IL - 1), OL);
|
||||||
pragma Assert (IL = OL);
|
pragma Assert (IL = OL);
|
||||||
|
|
||||||
--Ada.Text_IO.PUt (Standard.String(Buffer(Buffer'First .. Buffer'First + IL - 1)));
|
--Ada.Text_IO.PUt (Standard.String(Buffer(Buffer'First .. Buffer'First + IL - 1)));
|
||||||
@ -119,8 +129,21 @@ ada.text_io.put_line ("------------------");
|
|||||||
|
|
||||||
File.Write (F2, H2.Wide.String'("나는 피리부는 사나이 정말로 멋있는 사나이"), OL);
|
File.Write (F2, H2.Wide.String'("나는 피리부는 사나이 정말로 멋있는 사나이"), OL);
|
||||||
File.Write_Line (F2, H2.Wide.String'("이세상에 문디없어면 무슨재미로 너도 나도 만세."), OL);
|
File.Write_Line (F2, H2.Wide.String'("이세상에 문디없어면 무슨재미로 너도 나도 만세."), OL);
|
||||||
|
File.Write_Line (F2, H2.Wide.String'("이세상에 for the first time 우하."), OL);
|
||||||
|
File.Write_Line (F2, H2.Wide.String'(""), OL);
|
||||||
File.Close (F2);
|
File.Close (F2);
|
||||||
File.Close (F);
|
File.Close (F);
|
||||||
|
|
||||||
|
exception
|
||||||
|
when Error: others =>
|
||||||
|
Ada.Text_IO.Put_Line ("~~~~~~~~~~ EXCEPTION ~~~~~~~~~~" & Ada.Exceptions.Exception_Information(Error));
|
||||||
|
|
||||||
|
if File.Is_Open(F2) then
|
||||||
|
File.Close (F2);
|
||||||
|
end if;
|
||||||
|
if File.Is_Open(F) then
|
||||||
|
File.Close (F);
|
||||||
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
declare
|
declare
|
||||||
|
@ -5,7 +5,7 @@ generic
|
|||||||
type Character_Type is (<>);
|
type Character_Type is (<>);
|
||||||
package H2.Ascii is
|
package H2.Ascii is
|
||||||
|
|
||||||
pragma Preelaborate (Ascii);
|
--pragma Preelaborate (Ascii);
|
||||||
|
|
||||||
package Pos is
|
package Pos is
|
||||||
NUL : constant := 0;
|
NUL : constant := 0;
|
||||||
|
@ -4,8 +4,8 @@ separate (H2.IO)
|
|||||||
|
|
||||||
package body File is
|
package body File is
|
||||||
|
|
||||||
package Slim_Ascii is new H2.Ascii (Slim_Character);
|
package Slim_Ascii renames IO.Slim_Ascii;
|
||||||
package Wide_Ascii is new H2.Ascii (Wide_Character);
|
package Wide_Ascii renames IO.Wide_Ascii;
|
||||||
|
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
--| PRIVATE ROUTINES
|
--| PRIVATE ROUTINES
|
||||||
@ -34,237 +34,310 @@ package body File is
|
|||||||
Dst(Dst'First .. Dst'First + Length - 1) := Src(Src'First .. Src'First + Length - 1);
|
Dst(Dst'First .. Dst'First + Length - 1) := Src(Src'First .. Src'First + Length - 1);
|
||||||
end Copy_Array;
|
end Copy_Array;
|
||||||
|
|
||||||
|
|
||||||
|
Slim_Line_Terminator: Slim_String := Get_Line_Terminator;
|
||||||
|
--Wide_Line_Terminator: Wide_String := Get_Line_Terminator;
|
||||||
|
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
--| OPEN AND CLOSE
|
--| OPEN AND CLOSE
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
|
function Is_Open (File: in File_Record) return Standard.Boolean is
|
||||||
|
begin
|
||||||
|
return OS.File."/="(File.File, null);
|
||||||
|
end Is_Open;
|
||||||
|
|
||||||
procedure Open (File: in out File_Record;
|
procedure Open (File: in out File_Record;
|
||||||
Name: in Slim_String;
|
Name: in Slim_String;
|
||||||
Flag: in Flag_Record;
|
Flag: in Flag_Record;
|
||||||
Pool: in Storage_Pool_Pointer := null) is
|
Pool: in Storage_Pool_Pointer := null) is
|
||||||
|
pragma Assert (not Is_Open(File));
|
||||||
begin
|
begin
|
||||||
OS.File.Open (File.File, Name, Flag, Pool => Pool);
|
OS.File.Open (File.File, Name, Flag, Pool => Pool);
|
||||||
|
File.Rbuf.First := 0;
|
||||||
|
File.Rbuf.Last := 0;
|
||||||
File.Rbuf.Length := 0;
|
File.Rbuf.Length := 0;
|
||||||
|
|
||||||
File.Wbuf.Length := 0;
|
File.Wbuf.Length := 0;
|
||||||
File.EOF := Standard.False;
|
File.EOF := Standard.False;
|
||||||
|
--File.Slim_Line_Break := Get_Line_Terminator;
|
||||||
|
--File.Wide_Line_Break := Get_Line_Terminator;
|
||||||
end Open;
|
end Open;
|
||||||
|
|
||||||
procedure Open (File: in out File_Record;
|
procedure Open (File: in out File_Record;
|
||||||
Name: in Wide_String;
|
Name: in Wide_String;
|
||||||
Flag: in Flag_Record;
|
Flag: in Flag_Record;
|
||||||
Pool: in Storage_Pool_Pointer := null) is
|
Pool: in Storage_Pool_Pointer := null) is
|
||||||
|
pragma Assert (not Is_Open(File));
|
||||||
begin
|
begin
|
||||||
OS.File.Open (File.File, Name, Flag, Pool => Pool);
|
OS.File.Open (File.File, Name, Flag, Pool => Pool);
|
||||||
File.Rbuf.Length := 0;
|
File.Rbuf.Length := 0;
|
||||||
File.Wbuf.Length := 0;
|
File.Wbuf.Length := 0;
|
||||||
File.EOF := Standard.False;
|
File.EOF := Standard.False;
|
||||||
|
--File.Slim_Line_Break := Get_Line_Terminator;
|
||||||
|
--File.Wide_Line_Break := Get_Line_Terminator;
|
||||||
end Open;
|
end Open;
|
||||||
|
|
||||||
procedure Close (File: in out File_Record) is
|
procedure Close (File: in out File_Record) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
begin
|
begin
|
||||||
Flush (File);
|
Flush (File);
|
||||||
OS.File.Close (File.File);
|
OS.File.Close (File.File);
|
||||||
File.File := null;
|
File.File := null;
|
||||||
end Close;
|
end Close;
|
||||||
|
|
||||||
|
function Is_Empty (Buf: in File_Buffer) return Standard.Boolean is
|
||||||
|
pragma Inline (Is_Empty);
|
||||||
|
begin
|
||||||
|
return Buf.First >= Buf.Last;
|
||||||
|
end Is_Empty;
|
||||||
|
|
||||||
|
procedure Set_Length (Buf: in out File_Buffer; Length: in System_Length) is
|
||||||
|
pragma Inline (Set_Length);
|
||||||
|
begin
|
||||||
|
Buf.First := Buf.Data'First - 1; -- this should be 0
|
||||||
|
Buf.Last := Buf.First + Length;
|
||||||
|
end Set_Length;
|
||||||
|
|
||||||
|
procedure Load_Bytes (File: in out File_Record) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
pragma Assert (Is_Empty(File.Rbuf));
|
||||||
|
L1: System_Length;
|
||||||
|
begin
|
||||||
|
if File.EOF then
|
||||||
|
-- raise EOF EXCEPTION. ???
|
||||||
|
null;
|
||||||
|
else
|
||||||
|
-- Read bytes into the buffer
|
||||||
|
OS_Read_File (File, File.Rbuf.Data, L1);
|
||||||
|
Set_Length (File.Rbuf, L1);
|
||||||
|
end if;
|
||||||
|
end Load_Bytes;
|
||||||
|
|
||||||
|
procedure Fetch_Byte (File: in out File_Record;
|
||||||
|
Item: out System_Byte;
|
||||||
|
Available: out Standard.Boolean) is
|
||||||
|
begin
|
||||||
|
-- NOTE: If no data is available, Item is not initialized in this procedure
|
||||||
|
if Is_Empty(File.Rbuf) then
|
||||||
|
Load_Bytes (File);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Is_Empty(File.Rbuf) then
|
||||||
|
Available := Standard.False;
|
||||||
|
else
|
||||||
|
-- Consume 1 byte
|
||||||
|
Available := Standard.True;
|
||||||
|
File.Rbuf.First := File.Rbuf.First + 1;
|
||||||
|
Item := File.Rbuf.Data(File.Rbuf.First);
|
||||||
|
end if;
|
||||||
|
end Fetch_Byte;
|
||||||
|
|
||||||
|
procedure Fetch_Bytes (File: in out File_Record;
|
||||||
|
Item: out System_Byte_Array;
|
||||||
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
L1, L2: System_Length;
|
||||||
|
begin
|
||||||
|
if Is_Empty(File.Rbuf) and then File.EOF then
|
||||||
|
-- raise EOF EXCEPTION. ???
|
||||||
|
Length := 0;
|
||||||
|
else
|
||||||
|
L1 := File.Rbuf.Last - File.Rbuf.First;
|
||||||
|
if L1 > 0 then
|
||||||
|
-- Copy the residue over to the output buffer
|
||||||
|
if Item'Length <= L1 then
|
||||||
|
L2 := Item'Length;
|
||||||
|
else
|
||||||
|
L2 := L1;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Copy_Array (Item, File.Rbuf.Data(File.Rbuf.First + 1 .. File.Rbuf.Last), L2);
|
||||||
|
File.Rbuf.First := File.Rbuf.First + L2;
|
||||||
|
|
||||||
|
Length := L2;
|
||||||
|
else
|
||||||
|
Length := 0;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Item'Length > L1 then
|
||||||
|
-- Item is not full. the internal read buffer must be empty.
|
||||||
|
pragma Assert (File.Rbuf.First >= File.Rbuf.Last);
|
||||||
|
|
||||||
|
L2 := Item'Length - Length; -- Remaining capacity
|
||||||
|
If L2 >= File.Rbuf.Data'Length then
|
||||||
|
-- The remaining capacity of the output buffer is
|
||||||
|
-- higher than that of the internal buffer. So read
|
||||||
|
-- directly into the output buffer.
|
||||||
|
OS_Read_File (File, Item(Item'First + Length .. Item'Last), L2);
|
||||||
|
Length := Length + L2;
|
||||||
|
else
|
||||||
|
-- Read into the internal buffer.
|
||||||
|
OS_Read_File (File, File.Rbuf.Data, L1);
|
||||||
|
Set_Length (File.Rbuf, L1);
|
||||||
|
|
||||||
|
if L1 < L2 then
|
||||||
|
-- the actual bytes read may be less than the remaining capacity
|
||||||
|
L2 := L1;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
-- Copy as many bytes as needed into the output buffer.
|
||||||
|
Copy_Array (Item(Item'First + Length .. Item'Last), File.Rbuf.Data, L2);
|
||||||
|
Length := Length + L2;
|
||||||
|
File.Rbuf.First := File.Rbuf.First + L2;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end Fetch_Bytes;
|
||||||
|
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
--| READ SLIM STRING
|
--| READ SLIM STRING
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
procedure Read (File: in out File_Record;
|
procedure Read (File: in out File_Record;
|
||||||
Buffer: in out Slim_String;
|
Buffer: out Slim_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
pragma Assert (Buffer'Length > 0);
|
pragma Assert (Buffer'Length > 0);
|
||||||
|
|
||||||
Outbuf: System_Byte_Array (Buffer'Range);
|
Outbuf: System_Byte_Array (Buffer'Range);
|
||||||
for Outbuf'Address use Buffer'Address;
|
for Outbuf'Address use Buffer'Address;
|
||||||
|
|
||||||
Rbuf: File_Buffer renames File.Rbuf;
|
|
||||||
L1, L2: System_Length;
|
|
||||||
begin
|
begin
|
||||||
if Rbuf.Length <= 0 and then File.EOF then
|
Fetch_Bytes (File, Outbuf, Length);
|
||||||
-- 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
|
|
||||||
Copy_Array (Outbuf, Rbuf.Data, L1);
|
|
||||||
|
|
||||||
-- 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
|
|
||||||
Copy_Array (Outbuf, Rbuf.Data, L2);
|
|
||||||
|
|
||||||
-- Move the residue of the internal buffer to the head
|
|
||||||
Shift_Buffer (Rbuf, L2);
|
|
||||||
|
|
||||||
-- Set the output length
|
|
||||||
Length := L2;
|
|
||||||
end if;
|
|
||||||
end Read;
|
end Read;
|
||||||
|
|
||||||
procedure Read_Line (File: in out File_Record;
|
procedure Read_Line (File: in out File_Record;
|
||||||
Buffer: in out Slim_String;
|
Buffer: out Slim_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
pragma Assert (Buffer'Length > 0);
|
pragma Assert (Buffer'Length > 0);
|
||||||
|
|
||||||
Outbuf: System_Byte_Array (Buffer'Range);
|
Outbuf: System_Byte_Array (Buffer'Range);
|
||||||
for Outbuf'Address use Buffer'Address;
|
for Outbuf'Address use Buffer'Address;
|
||||||
|
|
||||||
Rbuf: File_Buffer renames File.Rbuf;
|
K: System_Length;
|
||||||
L1, L2, K: System_Length;
|
|
||||||
|
|
||||||
begin
|
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;
|
K := Outbuf'First - 1;
|
||||||
|
|
||||||
outer: loop
|
outer: loop
|
||||||
if Rbuf.Length < Rbuf.Data'Length then
|
if Is_Empty(File.Rbuf) then
|
||||||
-- Attempt to fill the internal buffer. It may not get full with a single read.
|
Load_Bytes (File);
|
||||||
OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1);
|
exit when Is_Empty(File.Rbuf);
|
||||||
Rbuf.Length := Rbuf.Length + L1;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
exit when Rbuf.Length <= 0;
|
while File.Rbuf.First < File.Rbuf.Last loop
|
||||||
|
|
||||||
L2 := Rbuf.Data'First + Rbuf.Length - 1; -- Last index of the internal buffer
|
|
||||||
for I in Rbuf.Data'First .. L2 loop
|
|
||||||
K := K + 1;
|
K := K + 1;
|
||||||
Outbuf(K) := Rbuf.Data(I);
|
File.Rbuf.First := File.Rbuf.First + 1;
|
||||||
|
Outbuf(K) := File.Rbuf.Data(File.Rbuf.First);
|
||||||
if K >= Outbuf'Last or else Outbuf(K) = Slim_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.
|
|
||||||
Shift_Buffer (Rbuf, L1); -- Shift the residue
|
|
||||||
exit outer; -- Done
|
exit outer; -- Done
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
-- Empty the internal buffer;
|
|
||||||
Rbuf.Length := 0;
|
|
||||||
end loop outer;
|
end loop outer;
|
||||||
|
|
||||||
Length := K + 1 - Outbuf'First;
|
Length := K + 1 - Outbuf'First;
|
||||||
end Read_Line;
|
end Read_Line;
|
||||||
|
|
||||||
|
procedure Get_Line (File: in out File_Record;
|
||||||
|
Buffer: out Slim_String;
|
||||||
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
pragma Assert (Buffer'Length > 0);
|
||||||
|
|
||||||
|
Last: System_Length;
|
||||||
|
begin
|
||||||
|
Read_Line (File, Buffer, Length);
|
||||||
|
|
||||||
|
if Length >= 1 then
|
||||||
|
Last := Buffer'First + Length - 1;
|
||||||
|
if Buffer(Last) = Slim_Ascii.LF then
|
||||||
|
if Last > Buffer'First and then Buffer(Last - 1) = Slim_Ascii.CR then
|
||||||
|
-- Switch CR/LF to LF
|
||||||
|
Length := Length - 1;
|
||||||
|
Buffer(Last - 1) := Slim_Ascii.LF;
|
||||||
|
end if;
|
||||||
|
elsif Buffer(Last) = Slim_Ascii.CR then
|
||||||
|
if Is_Empty(File.Rbuf) then
|
||||||
|
Load_Bytes (File);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if not Is_Empty(File.Rbuf) then
|
||||||
|
if File.Rbuf.Data(File.Rbuf.First + 1) = Slim_Ascii.Pos.LF then
|
||||||
|
-- Consume LF held in the internal read buffer.
|
||||||
|
File.Rbuf.First := File.Rbuf.First + 1;
|
||||||
|
-- Switch CR to LF (End-result: CR/LF to LF)
|
||||||
|
Buffer(Last) := Slim_Ascii.LF;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end Get_Line;
|
||||||
|
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
--| READ WIDE STRING
|
--| READ WIDE STRING
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
|
|
||||||
procedure Read_Wide (File: in out File_Record;
|
procedure Read_Wide (File: in out File_Record;
|
||||||
Buffer: in out Wide_String;
|
Buffer: out Wide_String;
|
||||||
Length: out System_Length;
|
Length: out System_Length;
|
||||||
Terminator: in Wide_String) is
|
Terminator: in Wide_String) is
|
||||||
|
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
pragma Assert (Buffer'Length > 0);
|
pragma Assert (Buffer'Length > 0);
|
||||||
|
|
||||||
Outbuf: Wide_String renames Buffer;
|
Outbuf: Wide_String renames Buffer;
|
||||||
|
Inbuf: Slim_String (File.Rbuf.Data'Range);
|
||||||
|
for Inbuf'Address use File.Rbuf.Data'Address;
|
||||||
|
|
||||||
Rbuf: File_Buffer renames File.Rbuf;
|
L3, L4, I, J, K: System_Length;
|
||||||
Inbuf: Slim_String (Rbuf.Data'Range);
|
|
||||||
for Inbuf'Address use Rbuf.Data'Address;
|
|
||||||
|
|
||||||
L1, L2, L3, L4, I, J, K: System_Length;
|
|
||||||
begin
|
begin
|
||||||
if Rbuf.Length <= 0 and then File.EOF then
|
|
||||||
-- raise EOF EXCEPTION. ???
|
|
||||||
Length := 0;
|
|
||||||
return;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
K := Outbuf'First - 1;
|
K := Outbuf'First - 1;
|
||||||
|
|
||||||
outer: while K < Outbuf'Last loop
|
outer: while K < Outbuf'Last loop
|
||||||
|
if Is_Empty(File.Rbuf) then
|
||||||
if Rbuf.Length < Rbuf.Data'Length then
|
Load_Bytes (File);
|
||||||
-- Attempt to fill the internal buffer. It may not get full with a single read.
|
exit when Is_Empty(File.Rbuf);
|
||||||
OS_Read_File (File, Rbuf.Data(Rbuf.Data'First + Rbuf.Length .. Rbuf.Data'Last), L1);
|
|
||||||
Rbuf.Length := Rbuf.Length + L1;
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
exit when Rbuf.Length <= 0;
|
while File.Rbuf.First < File.Rbuf.Last and K < Outbuf'Last loop
|
||||||
|
I := File.Rbuf.First + 1;
|
||||||
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
|
L3 := Sequence_Length(Inbuf(I)); -- Required number of bytes to compose a wide character
|
||||||
|
|
||||||
if L3 <= 0 then
|
if L3 <= 0 then
|
||||||
-- Potentially illegal sequence
|
-- Potentially illegal sequence
|
||||||
K := K + 1;
|
K := K + 1;
|
||||||
Outbuf(K) := Wide_Ascii.Question;
|
Outbuf(K) := Wide_Ascii.Question;
|
||||||
I := I + 1;
|
File.Rbuf.First := I;
|
||||||
else
|
else
|
||||||
L4 := L2 - I + 1; -- Avaliable number of bytes available in the internal buffer
|
L4 := File.Rbuf.Last - File.Rbuf.First; -- Avaliable number of bytes available in the internal buffer
|
||||||
if L4 < L3 then
|
if L4 < L3 then
|
||||||
-- Insufficient data available. Exit the inner loop to read more.
|
-- Insufficient data available. Exit the inner loop to read more.
|
||||||
exit;
|
exit;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
K := K + 1;
|
K := K + 1;
|
||||||
J := I + L3;
|
|
||||||
begin
|
begin
|
||||||
Outbuf(K..K) := Slim_To_Wide(Inbuf(I .. J - 1));
|
J := File.Rbuf.First + L3;
|
||||||
|
Outbuf(K..K) := Slim_To_Wide(Inbuf(I .. J));
|
||||||
exception
|
exception
|
||||||
when others =>
|
when others =>
|
||||||
Outbuf(K) := Wide_Ascii.Question;
|
Outbuf(K) := Wide_Ascii.Question;
|
||||||
J := I + 1; -- Override J to skip 1 byte only
|
J := I; -- Override J to skip 1 byte only.
|
||||||
end;
|
end;
|
||||||
I := J;
|
File.Rbuf.First := J;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Terminator'Length > 0 and then
|
if Terminator'Length > 0 and then
|
||||||
Outbuf(K) = Terminator(Terminator'First) then
|
Outbuf(K) = Terminator(Terminator'First) then
|
||||||
-- TODO: compare more characters in terminator, not just the first charactrer
|
-- TODO: compare more characters in terminator, not just the first charactrer
|
||||||
Shift_Buffer (Rbuf, I - Rbuf.Data'First);
|
|
||||||
exit outer;
|
exit outer;
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
-- Move the residue to the front.
|
|
||||||
Shift_Buffer (Rbuf, I - Rbuf.Data'First);
|
|
||||||
end loop outer;
|
end loop outer;
|
||||||
|
|
||||||
Length := K + 1 - Outbuf'First;
|
Length := K + 1 - Outbuf'First;
|
||||||
end Read_Wide;
|
end Read_Wide;
|
||||||
|
|
||||||
procedure Read (File: in out File_Record;
|
procedure Read (File: in out File_Record;
|
||||||
Buffer: in out Wide_String;
|
Buffer: out Wide_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
Terminator: Wide_String(1..0);
|
Terminator: Wide_String(1..0);
|
||||||
begin
|
begin
|
||||||
@ -272,19 +345,77 @@ package body File is
|
|||||||
end Read;
|
end Read;
|
||||||
|
|
||||||
procedure Read_Line (File: in out File_Record;
|
procedure Read_Line (File: in out File_Record;
|
||||||
Buffer: in out Wide_String;
|
Buffer: out Wide_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
Terminator: constant Wide_String(1..1) := (1 => Wide_Ascii.LF);
|
Terminator: constant Wide_String(1..1) := (1 => Wide_Ascii.LF);
|
||||||
begin
|
begin
|
||||||
Read_Wide (File, Buffer, Length, Terminator);
|
Read_Wide (File, Buffer, Length, Terminator);
|
||||||
end Read_Line;
|
end Read_Line;
|
||||||
|
|
||||||
|
procedure Get_Line (File: in out File_Record;
|
||||||
|
Buffer: out Wide_String;
|
||||||
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
pragma Assert (Buffer'Length > 0);
|
||||||
|
|
||||||
|
Last: System_Length;
|
||||||
|
begin
|
||||||
|
Read_Line (File, Buffer, Length);
|
||||||
|
|
||||||
|
if Length >= 1 then
|
||||||
|
Last := Buffer'First + Length - 1;
|
||||||
|
if Buffer(Last) = Wide_Ascii.LF then
|
||||||
|
if Last > Buffer'First and then Buffer(Last - 1) = Wide_Ascii.CR then
|
||||||
|
-- Switch CR/LF to LF
|
||||||
|
Length := Length - 1;
|
||||||
|
Buffer(Last - 1) := Wide_Ascii.LF;
|
||||||
|
end if;
|
||||||
|
elsif Buffer(Last) = Wide_Ascii.CR then
|
||||||
|
-- if the last character in the output buffer is CR,
|
||||||
|
-- i need to inspect the first character in the internal
|
||||||
|
-- read buffer to determine if it's CR/LF.
|
||||||
|
if Is_Empty(File.Rbuf) then
|
||||||
|
Load_Bytes (File);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if not Is_Empty(File.Rbuf) then
|
||||||
|
declare
|
||||||
|
Inbuf: Slim_String (File.Rbuf.Data'Range);
|
||||||
|
for Inbuf'Address use File.Rbuf.Data'Address;
|
||||||
|
L3, I, J: System_Length;
|
||||||
|
W: Wide_String(1..1);
|
||||||
|
begin
|
||||||
|
I := File.Rbuf.First + 1;
|
||||||
|
L3 := Sequence_Length(Inbuf(I)); -- Required number of bytes to compose a wide character
|
||||||
|
if L3 in 1 .. File.Rbuf.Last - File.Rbuf.First then
|
||||||
|
J := File.Rbuf.First + L3;
|
||||||
|
begin
|
||||||
|
W := Slim_To_Wide(Inbuf(I .. J));
|
||||||
|
exception
|
||||||
|
when others =>
|
||||||
|
W(1) := Wide_Ascii.NUL;
|
||||||
|
end;
|
||||||
|
if W(1) = Wide_Ascii.LF then
|
||||||
|
-- Consume LF held in the internal read buffer.
|
||||||
|
File.Rbuf.First := J;
|
||||||
|
-- Switch CR to LF (End-result: CR/LF to LF)
|
||||||
|
Buffer(Last) := Wide_Ascii.LF;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end Get_Line;
|
||||||
|
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
--| WRITE SLIM STRING
|
--| WRITE SLIM STRING
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
procedure Write (File: in out File_Record;
|
procedure Write (File: in out File_Record;
|
||||||
Buffer: in Slim_String;
|
Buffer: in Slim_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
|
||||||
Wbuf: File_Buffer renames File.Wbuf;
|
Wbuf: File_Buffer renames File.Wbuf;
|
||||||
|
|
||||||
Inbuf: System_Byte_Array (Buffer'Range);
|
Inbuf: System_Byte_Array (Buffer'Range);
|
||||||
@ -336,6 +467,8 @@ package body File is
|
|||||||
procedure Write_Line (File: in out File_Record;
|
procedure Write_Line (File: in out File_Record;
|
||||||
Buffer: in Slim_String;
|
Buffer: in Slim_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
|
||||||
Wbuf: File_Buffer renames File.Wbuf;
|
Wbuf: File_Buffer renames File.Wbuf;
|
||||||
|
|
||||||
Inbuf: System_Byte_Array (Buffer'Range);
|
Inbuf: System_Byte_Array (Buffer'Range);
|
||||||
@ -384,6 +517,8 @@ package body File is
|
|||||||
procedure Write (File: in out File_Record;
|
procedure Write (File: in out File_Record;
|
||||||
Buffer: in Wide_String;
|
Buffer: in Wide_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
|
||||||
Wbuf: File_Buffer renames File.Wbuf;
|
Wbuf: File_Buffer renames File.Wbuf;
|
||||||
F, L, I: System_Length;
|
F, L, I: System_Length;
|
||||||
begin
|
begin
|
||||||
@ -419,6 +554,7 @@ package body File is
|
|||||||
procedure Write_Line (File: in out File_Record;
|
procedure Write_Line (File: in out File_Record;
|
||||||
Buffer: in Wide_String;
|
Buffer: in Wide_String;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
|
||||||
Wbuf: File_Buffer renames File.Wbuf;
|
Wbuf: File_Buffer renames File.Wbuf;
|
||||||
F, L, I, LF: System_Length;
|
F, L, I, LF: System_Length;
|
||||||
@ -427,6 +563,11 @@ package body File is
|
|||||||
I := Buffer'First - 1;
|
I := Buffer'First - 1;
|
||||||
while I < Buffer'Last loop
|
while I < Buffer'Last loop
|
||||||
I := I + 1;
|
I := I + 1;
|
||||||
|
|
||||||
|
--if Buffer(I) = Wide_Ascii.LF then
|
||||||
|
--else
|
||||||
|
--end if;
|
||||||
|
|
||||||
declare
|
declare
|
||||||
Tmp: Slim_String := Wide_To_Slim(Buffer(I..I));
|
Tmp: Slim_String := Wide_To_Slim(Buffer(I..I));
|
||||||
Tmp2: System_Byte_Array(Tmp'Range);
|
Tmp2: System_Byte_Array(Tmp'Range);
|
||||||
@ -465,10 +606,13 @@ package body File is
|
|||||||
Length := I - Buffer'First + 1;
|
Length := I - Buffer'First + 1;
|
||||||
end Write_Line;
|
end Write_Line;
|
||||||
|
|
||||||
|
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
--| FLUSH AND DRAIN
|
--| FLUSH AND DRAIN
|
||||||
--|-----------------------------------------------------------------------
|
--|-----------------------------------------------------------------------
|
||||||
procedure Flush (File: in out File_Record) is
|
procedure Flush (File: in out File_Record) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
|
|
||||||
Wbuf: File_Buffer renames File.Wbuf;
|
Wbuf: File_Buffer renames File.Wbuf;
|
||||||
Length: System_Length;
|
Length: System_Length;
|
||||||
begin
|
begin
|
||||||
@ -487,7 +631,9 @@ package body File is
|
|||||||
end Flush;
|
end Flush;
|
||||||
|
|
||||||
procedure Drain (File: in out File_Record) is
|
procedure Drain (File: in out File_Record) is
|
||||||
|
pragma Assert (Is_Open(File));
|
||||||
begin
|
begin
|
||||||
File.Wbuf.Length := 0;
|
File.Wbuf.Length := 0;
|
||||||
end Drain;
|
end Drain;
|
||||||
|
|
||||||
end File;
|
end File;
|
||||||
|
@ -1,5 +1,11 @@
|
|||||||
|
with ada.text_io;
|
||||||
|
|
||||||
package body H2.IO is
|
package body H2.IO is
|
||||||
|
|
||||||
package body File is separate;
|
package body File is separate;
|
||||||
|
|
||||||
|
|
||||||
|
function Get_Line_Terminator return Slim_String is separate;
|
||||||
|
--function Get_Line_Terminator return Wide_String is separate;
|
||||||
|
|
||||||
end H2.IO;
|
end H2.IO;
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
with H2.OS;
|
with H2.OS;
|
||||||
|
with H2.Ascii;
|
||||||
|
|
||||||
generic
|
generic
|
||||||
type Slim_Character is (<>);
|
type Slim_Character is (<>);
|
||||||
@ -12,6 +13,11 @@ generic
|
|||||||
package H2.IO is
|
package H2.IO is
|
||||||
|
|
||||||
package OS is new H2.OS (Slim_Character, Wide_Character, Slim_String, Wide_String, Slim_To_Wide, Wide_To_Slim);
|
package OS is new H2.OS (Slim_Character, Wide_Character, Slim_String, Wide_String, Slim_To_Wide, Wide_To_Slim);
|
||||||
|
package Slim_Ascii is new H2.Ascii (Slim_Character);
|
||||||
|
package Wide_Ascii is new H2.Ascii (Wide_Character);
|
||||||
|
|
||||||
|
function Get_Line_Terminator return Slim_String;
|
||||||
|
--function Get_Line_Terminator return Wide_String;
|
||||||
|
|
||||||
package File is
|
package File is
|
||||||
|
|
||||||
@ -31,13 +37,15 @@ package H2.IO is
|
|||||||
type File_Buffer is private;
|
type File_Buffer is private;
|
||||||
type File_Record is limited private;
|
type File_Record is limited private;
|
||||||
|
|
||||||
|
|
||||||
procedure Set_Flag_Bits (Flag: in out Flag_Record;
|
procedure Set_Flag_Bits (Flag: in out Flag_Record;
|
||||||
Bits: in Flag_Bits) renames OS.File.Set_Flag_Bits;
|
Bits: in Flag_Bits) renames OS.File.Set_Flag_Bits;
|
||||||
|
|
||||||
procedure Clear_Flag_Bits (Flag: in out Flag_Record;
|
procedure Clear_Flag_Bits (Flag: in out Flag_Record;
|
||||||
Bits: in Flag_Bits) renames OS.File.Clear_Flag_Bits;
|
Bits: in Flag_Bits) renames OS.File.Clear_Flag_Bits;
|
||||||
|
|
||||||
|
function Is_Open (File: in File_Record) return Standard.Boolean;
|
||||||
|
pragma Inline (Is_Open);
|
||||||
|
|
||||||
procedure Open (File: in out File_Record;
|
procedure Open (File: in out File_Record;
|
||||||
Name: in Slim_String;
|
Name: in Slim_String;
|
||||||
Flag: in Flag_Record;
|
Flag: in Flag_Record;
|
||||||
@ -48,22 +56,39 @@ package H2.IO is
|
|||||||
Flag: in Flag_Record;
|
Flag: in Flag_Record;
|
||||||
Pool: in Storage_Pool_Pointer := null);
|
Pool: in Storage_Pool_Pointer := null);
|
||||||
|
|
||||||
|
|
||||||
procedure Close (File: in out File_Record);
|
procedure Close (File: in out File_Record);
|
||||||
|
|
||||||
|
-- The Read procedure reads as many characters as the buffer
|
||||||
|
-- can hold with a single system call at most.
|
||||||
procedure Read (File: in out File_Record;
|
procedure Read (File: in out File_Record;
|
||||||
Buffer: in out Slim_String;
|
Buffer: out Slim_String;
|
||||||
Length: out System_Length);
|
Length: out System_Length);
|
||||||
|
|
||||||
|
-- The Read_Line procedure reads a single line into the bufer.
|
||||||
|
-- If the buffer is not large enough, it may not contain a full line.
|
||||||
|
-- The remaining part can be returned in the next call.
|
||||||
procedure Read_Line (File: in out File_Record;
|
procedure Read_Line (File: in out File_Record;
|
||||||
Buffer: in out Slim_String;
|
Buffer: out Slim_String;
|
||||||
|
Length: out System_Length);
|
||||||
|
|
||||||
|
|
||||||
|
-- The Get_Line procedure acts like Read_Line but the line terminator
|
||||||
|
-- is translated to LF.
|
||||||
|
procedure Get_Line (File: in out File_Record;
|
||||||
|
Buffer: out Slim_String;
|
||||||
Length: out System_Length);
|
Length: out System_Length);
|
||||||
|
|
||||||
procedure Read (File: in out File_Record;
|
procedure Read (File: in out File_Record;
|
||||||
Buffer: in out Wide_String;
|
Buffer: out Wide_String;
|
||||||
Length: out System_Length);
|
Length: out System_Length);
|
||||||
|
|
||||||
procedure Read_Line (File: in out File_Record;
|
procedure Read_Line (File: in out File_Record;
|
||||||
Buffer: in out Wide_String;
|
Buffer: out Wide_String;
|
||||||
|
Length: out System_Length);
|
||||||
|
|
||||||
|
procedure Get_Line (File: in out File_Record;
|
||||||
|
Buffer: out Wide_String;
|
||||||
Length: out System_Length);
|
Length: out System_Length);
|
||||||
|
|
||||||
procedure Write (File: in out File_Record;
|
procedure Write (File: in out File_Record;
|
||||||
@ -85,7 +110,6 @@ package H2.IO is
|
|||||||
Buffer: in Wide_String;
|
Buffer: in Wide_String;
|
||||||
Length: out System_Length);
|
Length: out System_Length);
|
||||||
|
|
||||||
|
|
||||||
procedure Flush (File: in out File_Record);
|
procedure Flush (File: in out File_Record);
|
||||||
procedure Drain (File: in out File_Record);
|
procedure Drain (File: in out File_Record);
|
||||||
|
|
||||||
@ -100,6 +124,8 @@ package H2.IO is
|
|||||||
-- multi-byte sequence for a single wide character.
|
-- multi-byte sequence for a single wide character.
|
||||||
Data: System_Byte_Array (1 .. 2048);
|
Data: System_Byte_Array (1 .. 2048);
|
||||||
Length: System_Length := 0;
|
Length: System_Length := 0;
|
||||||
|
First: System_Length := 0;
|
||||||
|
Last: System_Length := 0;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
type File_Record is limited record
|
type File_Record is limited record
|
||||||
|
@ -84,7 +84,7 @@ package H2.OS is
|
|||||||
procedure Close (File: in out File_Pointer);
|
procedure Close (File: in out File_Pointer);
|
||||||
|
|
||||||
procedure Read (File: in File_Pointer;
|
procedure Read (File: in File_Pointer;
|
||||||
Buffer: in out System_Byte_Array;
|
Buffer: out System_Byte_Array;
|
||||||
Length: out System_Length);
|
Length: out System_Length);
|
||||||
|
|
||||||
procedure Write (File: in File_Pointer;
|
procedure Write (File: in File_Pointer;
|
||||||
|
@ -13,7 +13,7 @@ generic
|
|||||||
Storage_Pool: in Storage_Pool_Pointer := null;
|
Storage_Pool: in Storage_Pool_Pointer := null;
|
||||||
|
|
||||||
package H2.Pool is
|
package H2.Pool is
|
||||||
pragma Preelaborate (Pool);
|
--pragma Preelaborate (Pool);
|
||||||
|
|
||||||
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
||||||
|
|
||||||
|
@ -2768,6 +2768,7 @@ end;
|
|||||||
end Run_Loop;
|
end Run_Loop;
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
--
|
--
|
||||||
-- function h2scm_open return Interpreter_Pointer;
|
-- function h2scm_open return Interpreter_Pointer;
|
||||||
-- pragma Export (C, h2scm_open, "h2scm_open");
|
-- pragma Export (C, h2scm_open, "h2scm_open");
|
||||||
|
@ -6,4 +6,5 @@ package H2.Slim is
|
|||||||
type String is array(System_Index range<>) of Character;
|
type String is array(System_Index range<>) of Character;
|
||||||
package Scheme is new H2.Scheme (Character);
|
package Scheme is new H2.Scheme (Character);
|
||||||
|
|
||||||
|
pragma Assert (Character'Size = System_Byte'Size);
|
||||||
end H2.Slim;
|
end H2.Slim;
|
||||||
|
@ -170,7 +170,7 @@ package body H2.Utf8 is
|
|||||||
|
|
||||||
procedure To_Unicode_String (Seq: in Utf8_String;
|
procedure To_Unicode_String (Seq: in Utf8_String;
|
||||||
Seq_Len: out System_Length;
|
Seq_Len: out System_Length;
|
||||||
Str: in out Unicode_String;
|
Str: out Unicode_String;
|
||||||
Str_Len: out System_Length) is
|
Str_Len: out System_Length) is
|
||||||
Seq_Pos: System_Index := Seq'First;
|
Seq_Pos: System_Index := Seq'First;
|
||||||
Str_Pos: System_Index := Str'First;
|
Str_Pos: System_Index := Str'First;
|
||||||
|
@ -4,7 +4,7 @@ generic
|
|||||||
type Slim_String is array(System_Index range<>) of Slim_Character;
|
type Slim_String is array(System_Index range<>) of Slim_Character;
|
||||||
type Wide_String is array(System_Index range<>) of Wide_Character;
|
type Wide_String is array(System_Index range<>) of Wide_Character;
|
||||||
package H2.Utf8 is
|
package H2.Utf8 is
|
||||||
pragma Preelaborate (Utf8);
|
--pragma Preelaborate (Utf8);
|
||||||
|
|
||||||
--Invalid_Unicode_Character: exception renames Invalid_Wide_Character;
|
--Invalid_Unicode_Character: exception renames Invalid_Wide_Character;
|
||||||
--Invalid_Utf8_Sequence: exception renames Invalid_Slim_Sequence;
|
--Invalid_Utf8_Sequence: exception renames Invalid_Slim_Sequence;
|
||||||
@ -43,7 +43,7 @@ package H2.Utf8 is
|
|||||||
|
|
||||||
procedure To_Unicode_String (Seq: in Utf8_String;
|
procedure To_Unicode_String (Seq: in Utf8_String;
|
||||||
Seq_Len: out System_Length;
|
Seq_Len: out System_Length;
|
||||||
Str: in out Unicode_String;
|
Str: out Unicode_String;
|
||||||
Str_Len: out System_Length);
|
Str_Len: out System_Length);
|
||||||
|
|
||||||
function To_Unicode_Character (Seq: in Utf8_String) return Unicode_Character;
|
function To_Unicode_Character (Seq: in Utf8_String) return Unicode_Character;
|
||||||
|
@ -2,6 +2,8 @@ with H2.Scheme;
|
|||||||
with H2.Utf8;
|
with H2.Utf8;
|
||||||
with H2.Slim;
|
with H2.Slim;
|
||||||
|
|
||||||
|
-- TODO: rename H2.Wide to H2.Wide_Utf8 or soemthing...
|
||||||
|
|
||||||
package H2.Wide is
|
package H2.Wide is
|
||||||
|
|
||||||
subtype Character is Standard.Wide_Character;
|
subtype Character is Standard.Wide_Character;
|
||||||
|
10
lib/h2.ads
10
lib/h2.ads
@ -2,7 +2,7 @@ with System;
|
|||||||
with System.Storage_Pools;
|
with System.Storage_Pools;
|
||||||
|
|
||||||
package H2 is
|
package H2 is
|
||||||
pragma Preelaborate (H2);
|
--pragma Preelaborate (H2);
|
||||||
|
|
||||||
System_Word_Bits: constant := System.Word_Size;
|
System_Word_Bits: constant := System.Word_Size;
|
||||||
System_Word_Bytes: constant := System_Word_Bits / System.Storage_Unit;
|
System_Word_Bytes: constant := System_Word_Bits / System.Storage_Unit;
|
||||||
@ -24,8 +24,12 @@ package H2 is
|
|||||||
type Storage_Pool_Pointer is
|
type Storage_Pool_Pointer is
|
||||||
access all System.Storage_Pools.Root_Storage_Pool'Class;
|
access all System.Storage_Pools.Root_Storage_Pool'Class;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type System_Byte_Array is array(System_Index range<>) of System_Byte;
|
type System_Byte_Array is array(System_Index range<>) of System_Byte;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end H2;
|
end H2;
|
||||||
|
@ -27,6 +27,7 @@ project Lib is
|
|||||||
"h2-io.ads",
|
"h2-io.ads",
|
||||||
"h2-io.adb",
|
"h2-io.adb",
|
||||||
"h2-io-file.adb",
|
"h2-io-file.adb",
|
||||||
|
"h2-io-get_line_terminator.adb",
|
||||||
"h2-scheme.adb",
|
"h2-scheme.adb",
|
||||||
"h2-scheme.ads",
|
"h2-scheme.ads",
|
||||||
"h2-scheme-bigint.adb",
|
"h2-scheme-bigint.adb",
|
||||||
|
@ -140,7 +140,7 @@ package body File is
|
|||||||
end Close;
|
end Close;
|
||||||
|
|
||||||
procedure Read (File: in File_Pointer;
|
procedure Read (File: in File_Pointer;
|
||||||
Buffer: in out System_Byte_Array;
|
Buffer: out System_Byte_Array;
|
||||||
Length: out System_Length) is
|
Length: out System_Length) is
|
||||||
pragma Assert (Buffer'Length > 0);
|
pragma Assert (Buffer'Length > 0);
|
||||||
F: Posix_File_Pointer := Posix_File_Pointer(File);
|
F: Posix_File_Pointer := Posix_File_Pointer(File);
|
||||||
|
Loading…
Reference in New Issue
Block a user