hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implemented some functions h2-io-file.

Browse Source 
renamed h2-sysapi to h2-os
This commit is contained in:
hyung-hwan 2014-06-05 15:26:37 +00:00
parent 744915575f
commit d78d6ffa1d
10 changed files with 339 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
cmd/scheme.adb
View File

@ -9,8 +9,9 @@ with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with H2.Sysapi;
with H2.OS;
with H2.IO;
use type H2.System_Length;
with Interfaces.C;
@ -44,27 +45,27 @@ begin
--h2init;
declare
package Sysapi is new H2.Sysapi (
package OS is new H2.OS (
H2.Slim.Character,
H2.Wide.Character,
H2.Slim.String,
H2.Wide.String,
H2.Wide.Utf8.To_Unicode_String,
H2.Wide.Utf8.From_Unicode_String);
package File renames Sysapi.File;
package File renames OS.File;
F: File.File_Pointer;
FL: File.Flag_Record;
Last: H2.System_Length;
Length: H2.System_Length;
Buffer: H2.System_Byte_Array (50 .. 100);
begin
--Sysapi.File.Set_Flag_Bits (FL, Sysapi.File.FLAG_WRITE);
--OS.File.Set_Flag_Bits (FL, OS.File.FLAG_WRITE);
File.Set_Flag_Bits (FL, File.FLAG_READ);
File.Open (F, H2.Wide.String'("/etc/passwd"), FL);
File.Read (F, Buffer, Last);
File.Read (F, Buffer, Length);
File.Close (F);
File.Write (Sysapi.File.Get_Stdout, Buffer(Buffer'First .. Last), Last);
File.Write (OS.File.Get_Stdout, Buffer(Buffer'First .. Buffer'First + Length - 1), Length);
end;
declare
@ -74,14 +75,35 @@ declare
H2.Slim.String,
H2.Wide.String,
H2.Wide.Utf8.To_Unicode_String,
H2.Wide.Utf8.From_Unicode_String);
H2.Wide.Utf8.From_Unicode_String,
H2.Wide.Utf8.Sequence_Length);
package File renames IO.File;
F: File.File_Record;
FL: File.Flag_Record;
Buffer: H2.Slim.String (1 .. 10);
Length: H2.System_Length;
begin
File.Open (F, H2.Slim.String'("/tmp/qq"), FL);
--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)));
--File.Close (F);
ada.text_io.put_line ("------------------");
File.Open (F, H2.Slim.String'("/etc/passwd"), 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)));
end loop;
File.Close (F);
end;

6
lib/Makefile.am
View File

@ -8,9 +8,9 @@ EXTRA_DIST = \
h2-ascii.ads \
h2-utf8.ads \
h2-utf8.adb \
h2-sysapi.ads \
h2-sysapi.adb \
posix/h2-sysapi-file.adb \
h2-os.ads \
h2-os.adb \
posix/h2-os-file.adb \
h2-io.ads \
h2-io.adb \
h2-io-file.adb \

6
lib/Makefile.in
View File

@ -178,9 +178,9 @@ EXTRA_DIST = \
h2-ascii.ads \
h2-utf8.ads \
h2-utf8.adb \
h2-sysapi.ads \
h2-sysapi.adb \
posix/h2-sysapi-file.adb \
h2-os.ads \
h2-os.adb \
posix/h2-os-file.adb \
h2-io.ads \
h2-io.adb \
h2-io-file.adb \

212
lib/h2-io-file.adb
View File

@ -1,3 +1,5 @@
with H2.Ascii;
separate (H2.IO)
package body File is
@ -7,7 +9,10 @@ package body File is
Flag: in Flag_Record;
Pool: in Storage_Pool_Pointer := null) is
begin
Sysapi.File.Open (File.File, Name, flag, Pool => Pool);
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;
@ -15,41 +20,226 @@ package body File is
Flag: in Flag_Record;
Pool: in Storage_Pool_Pointer := null) is
begin
Sysapi.File.Open (File.File, Name, flag, Pool => Pool);
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
Sysapi.File.Close (File.File);
OS.File.Close (File.File);
File.File := null;
File.Last := System_Length'First;
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;
Last: out System_Length) is
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
null;
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;
Last: out System_Length) is
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;
end Read_Line;
procedure Write (File: in out File_Record;
Buffer: in Slim_String;
Last: out System_Length) is
Length: out System_Length) is
begin
null;
end Write;
procedure Write (File: in out File_Record;
Buffer: in Wide_String;
Last: out System_Length) is
Length: out System_Length) is
begin
null;
end Write;

71
lib/h2-io.ads
View File

@ -1,4 +1,4 @@
with H2.Sysapi;
with H2.OS;
generic
type Slim_Character is (<>);
@ -7,31 +7,36 @@ generic
type Wide_String is array(System_Index range<>) of Wide_Character;
with function Slim_To_Wide (Slim: in Slim_String) return Wide_String;
with function Wide_To_Slim (Wide: in Wide_String) return Slim_String;
with function Sequence_Length (Slim: in Slim_Character) return System_Length;
package H2.IO is
package Sysapi is new H2.Sysapi (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 File is
subtype Flag_Record is Sysapi.File.Flag_Record;
subtype Flag_Record is OS.File.Flag_Record;
subtype Flag_Bits is OS.File.Flag_Bits;
FLAG_READ: constant := Sysapi.File.FLAG_READ;
FLAG_WRITE: constant := Sysapi.File.FLAG_WRITE;
FLAG_CREATE: constant := Sysapi.File.FLAG_CREATE;
FLAG_EXCLUSIVE: constant := Sysapi.File.FLAG_EXCLUSIVE;
FLAG_TRUNCATE: constant := Sysapi.File.FLAG_TRUNCATE;
FLAG_APPEND: constant := Sysapi.File.FLAG_APPEND;
FLAG_NONBLOCK: constant := Sysapi.File.FLAG_NONBLOCK;
FLAG_SYNC: constant := Sysapi.File.FLAG_SYNC;
FLAG_NOFOLLOW: constant := Sysapi.File.FLAG_NOFOLLOW;
FLAG_READ: constant Flag_Bits := OS.File.FLAG_READ;
FLAG_WRITE: constant Flag_Bits := OS.File.FLAG_WRITE;
FLAG_CREATE: constant Flag_Bits := OS.File.FLAG_CREATE;
FLAG_EXCLUSIVE: constant Flag_Bits := OS.File.FLAG_EXCLUSIVE;
FLAG_TRUNCATE: constant Flag_Bits := OS.File.FLAG_TRUNCATE;
FLAG_APPEND: constant Flag_Bits := OS.File.FLAG_APPEND;
FLAG_NONBLOCK: constant Flag_Bits := OS.File.FLAG_NONBLOCK;
FLAG_SYNC: constant Flag_Bits := OS.File.FLAG_SYNC;
FLAG_NOFOLLOW: constant Flag_Bits := OS.File.FLAG_NOFOLLOW;
type File_Record is limited record
File: Sysapi.File.File_Pointer := null;
Buffer: System_Byte_Array (1 .. 2048);
Last: System_Length := System_Length'First;
end record;
type File_Buffer is private;
type File_Record is limited private;
procedure Set_Flag_Bits (Flag: in out Flag_Record;
Bits: in Flag_Bits) renames OS.File.Set_Flag_Bits;
procedure Clear_Flag_Bits (Flag: in out Flag_Record;
Bits: in Flag_Bits) renames OS.File.Clear_Flag_Bits;
procedure Open (File: in out File_Record;
Name: in Slim_String;
@ -47,21 +52,43 @@ package H2.IO is
procedure Read (File: in out File_Record;
Buffer: in out Slim_String;
Last: out System_Length);
Length: out System_Length);
procedure Read (File: in out File_Record;
Buffer: in out Wide_String;
Last: out System_Length);
Length: out System_Length);
procedure Read_Line (File: in out File_Record;
Buffer: in out Slim_String;
Length: out System_Length);
procedure Read_Line (File: in out File_Record;
Buffer: in out Wide_String;
Length: out System_Length);
procedure Write (File: in out File_Record;
Buffer: in Slim_String;
Last: out System_Length);
Length: out System_Length);
procedure Write (File: in out File_Record;
Buffer: in Wide_String;
Last: out System_Length);
Length: out System_Length);
procedure Flush (File: in out File_Record);
private
type File_Buffer is record
Data: System_Byte_Array (1 .. 2048); -- TODO: determine the best size
Length: System_Length := 0;
end record;
type File_Record is limited record
File: OS.File.File_Pointer := null;
Rbuf: File_Buffer;
Wbuf: File_Buffer;
EOF: Standard.Boolean := false;
end record;
end File;
end H2.IO;

4
lib/h2-sysapi.adb → lib/h2-os.adb
View File

@ -1,4 +1,4 @@
package body H2.Sysapi is
package body H2.OS is
package body File is separate;
@ -12,4 +12,4 @@ package body H2.Sysapi is
Flag.Bits := Flag.Bits and not Bits;
end Clear_File_Flag_Bits;
end H2.Sysapi;
end H2.OS;

27
lib/h2-sysapi.ads → lib/h2-os.ads
View File

@ -7,7 +7,7 @@ generic
with function Slim_To_Wide (Slim: in Slim_String) return Wide_String;
with function Wide_To_Slim (Wide: in Wide_String) return Slim_String;
package H2.Sysapi is
package H2.OS is
@ -21,17 +21,20 @@ package H2.Sysapi is
Bits: File_Mode_Bits := 0;
end record;
procedure Set_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits);
procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record; Bits: in File_Flag_Bits);
procedure Set_File_Flag_Bits (Flag: in out File_Flag_Record;
Bits: in File_Flag_Bits);
procedure Clear_File_Flag_Bits (Flag: in out File_Flag_Record;
Bits: in File_Flag_Bits);
package File is
type File_Record is tagged null record;
type File_Pointer is access all File_Record'Class;
subtype Flag_Bits is Sysapi.File_Flag_Bits;
subtype Mode_Bits is Sysapi.File_Mode_Bits;
subtype Flag_Record is Sysapi.File_Flag_Record;
subtype Mode_Record is Sysapi.File_Mode_Record;
subtype Flag_Bits is OS.File_Flag_Bits;
subtype Mode_Bits is OS.File_Mode_Bits;
subtype Flag_Record is OS.File_Flag_Record;
subtype Mode_Record is OS.File_Mode_Record;
FLAG_READ: constant Flag_Bits := 2#0000_0000_0000_0001#;
FLAG_WRITE: constant Flag_Bits := 2#0000_0000_0000_0010#;
@ -59,10 +62,10 @@ package H2.Sysapi is
DEFAULT_MODE: constant Mode_Record := ( Bits => 2#110_100_100# );
procedure Set_Flag_Bits (Flag: in out Flag_Record;
Bits: in Flag_Bits) renames Sysapi.Set_File_Flag_Bits;
Bits: in Flag_Bits) renames OS.Set_File_Flag_Bits;
procedure Clear_Flag_Bits (Flag: in out Flag_Record;
Bits: in Flag_Bits) renames Sysapi.Clear_File_Flag_Bits;
Bits: in Flag_Bits) renames OS.Clear_File_Flag_Bits;
function Get_Stdin return File_Pointer;
function Get_Stdout return File_Pointer;
@ -84,11 +87,11 @@ package H2.Sysapi is
procedure Read (File: in File_Pointer;
Buffer: in out System_Byte_Array;
Last: out System_Length);
Length: out System_Length);
procedure Write (File: in File_Pointer;
Buffer: in System_Byte_Array;
Last: out System_Length);
Length: out System_Length);
pragma Inline (Get_Stdin);
pragma Inline (Get_Stdout);
@ -100,4 +103,4 @@ package H2.Sysapi is
-- Mode: in Mode_Record) renames File.Open;
--procedure Close_File (File: in out File_Pointer) renames File.Close;
end H2.Sysapi;
end H2.OS;

3
lib/h2-utf8.ads
View File

@ -6,6 +6,9 @@ generic
package H2.Utf8 is
pragma Preelaborate (Utf8);
--Invalid_Unicode_Character: exception renames Invalid_Wide_Character;
--Invalid_Utf8_Sequence: exception renames Invalid_Slim_Sequence;
--Insufficient_Utf8_Sequence: exception renames Insifficient_Slim_Sequence;
Invalid_Unicode_Character: exception;
Invalid_Utf8_Sequence: exception;
Insufficient_Utf8_Sequence: exception;

27
lib/lib.gpr.in
View File

@ -1,10 +1,14 @@
project Lib is
type Platform_Type is ("posix", "win32");
Platform: Platform_Type := external ("platform", "posix");
for Source_Dirs use (
"@abs_srcdir@",
"@abs_srcdir@/posix",
"@abs_builddir@/posix"
"@abs_srcdir@/" & Platform,
"@abs_builddir@/" & Platform
);
for Library_Name use "h2";
for Library_Kind use "dynamic";
for Library_Dir use ".";
@ -13,10 +17,13 @@ project Lib is
for Source_Files use (
"h2.ads",
"h2-sysdef.ads",
"h2-ascii.ads",
"h2-pool.adb",
"h2-pool.ads",
"h2-os.adb",
"h2-os.ads",
"h2-os-file.adb",
"h2-sysdef.ads",
"h2-io.ads",
"h2-io.adb",
"h2-io-file.adb",
@ -28,9 +35,6 @@ project Lib is
"h2-scheme-execute-evaluate.adb",
"h2-scheme-token.adb",
"h2-slim.ads",
"h2-sysapi.adb",
"h2-sysapi.ads",
"h2-sysapi-file.adb",
"h2-utf8.adb",
"h2-utf8.ads",
"h2-wide.ads",
@ -43,8 +47,8 @@ project Lib is
"h2.pool",
"h2.scheme",
"h2.slim",
"h2.sysapi",
"h2.sysdef",
"h2.os",
"h2.utf8",
"h2.wide",
"h2.wide_wide"
@ -56,6 +60,15 @@ project Lib is
);
end Compiler;
--package Naming is
-- case Platform is
-- when "posix" =>
-- for Body ("H2.OS.File") use "h2-os-file-posix.adb";
-- when "win32" =>
-- for Body ("H2.OS.File") use "h2-os-file-win32.adb";
-- end case;
--end Naming;
--package Install is
-- for Prefix use "@prefix@";
--end Install;

21
lib/posix/h2-sysapi-file.adb → lib/posix/h2-os-file.adb
View File

@ -2,7 +2,7 @@
with H2.Pool;
with H2.Sysdef;
separate (H2.Sysapi)
separate (H2.OS)
package body File is
@ -131,32 +131,35 @@ package body File is
end if;
end Close;
procedure Read (File: in File_Pointer; Buffer: in out System_Byte_Array; Last: out System_Length) is
procedure Read (File: in File_Pointer;
Buffer: in out System_Byte_Array;
Length: out System_Length) is
pragma Assert (Buffer'Length > 0);
F: Posix_File_Pointer := Posix_File_Pointer(File);
N: Sysdef.ssize_t;
begin
N := Sys_Read (F.Handle, Buffer'Address, Buffer'Length);
if Sysdef."<=" (N, ERROR_RETURN) then
raise Constraint_Error; -- TODO rename exception
elsif Sysdef."=" (N, 0) then
Last := Buffer'First - 1;
else
Last := Buffer'First + System_Length(N) - 1;
Length := System_Length(N);
end if;
end Read;
procedure Write (File: in File_Pointer; Buffer: in System_Byte_Array; Last: out System_Length) is
procedure Write (File: in File_Pointer;
Buffer: in System_Byte_Array;
Length: out System_Length) is
pragma Assert (Buffer'Length > 0);
F: Posix_File_Pointer := Posix_File_Pointer(File);
N: Sysdef.ssize_t;
begin
N := Sys_Write (F.Handle, Buffer'Address, Buffer'Length);
if Sysdef."<=" (N, ERROR_RETURN) then
raise Constraint_Error; -- TODO rename exception
elsif Sysdef."=" (N, 0) then
Last := Buffer'First - 1;
else
Last := Buffer'First + System_Length(N) - 1;
Length := System_Length(N);
end if;
end Write;
end File;