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

improved h2-io-file a bit

Browse Source
This commit is contained in:
hyung-hwan
2014-06-21 16:31:49 +00:00
parent 710109bc28
commit 91cd073f8b
16 changed files with 750 additions and 367 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
lib/win32/h2-io-file-get_default_option.adb Normal file
View File

@ -0,0 +1,13 @@
separate (H2.IO.File)
function Get_Default_Option return Option_Record is
Default_Option: constant Option_Record := (
Bits => (OPTION_CRLF_IN or OPTION_CRLF_OUT),
CR => Ascii.Code.CR,
LF => Ascii.Code.LF
);
begin
return Default_Option;
end Get_Default_Option;

187
lib/win32/h2-os-file.adb Normal file
View File

@ -0,0 +1,187 @@
with H2.Pool;
with H2.Sysdef;
separate (H2.OS)
package body File is
-- External functions and procedures
function CreateFileA (lpFileName : Slim_String;
dwDesiredAccess : Sysdef.DWORD;
dwShareMode : Sysdef.DWORD;
lpSecurityAttributes : Sysdef.PVOID; -- LPSECURITY_ATTRIBUTES;
dwCreationDisposition: Sysdef.DWORD;
dwFlagsAndAttributes : Sysdef.DWORD;
hTemplateFile : Sysdef.HANDLE) return Sysdef.HANDLE;
pragma Import (Stdcall, CreateFileA, "CreateFileA");
function CreateFileW (lpFileName : Wide_String;
dwDesiredAccess : Sysdef.DWORD;
dwShareMode : Sysdef.DWORD;
lpSecurityAttributes : Sysdef.PVOID; -- LPSECURITY_ATTRIBUTES;
dwCreationDisposition: Sysdef.DWORD;
dwFlagsAndAttributes : Sysdef.DWORD;
hTemplateFile : Sysdef.HANDLE) return Sysdef.HANDLE;
pragma Import (Stdcall, CreateFileW, "CreateFileW");
procedure CloseFile (fd: Sysdef.HANDLE);
pragma Import (Stdcall, CloseFile, "CloseFile");
function ReadFile (fd: Sysdef.HANDLE; buf: in System.Address; count: in Sysdef.size_t) return Sysdef.ssize_t;
pragma Import (Stdcall, ReadFile, "ReadFile");
function Sys_Write (fd: Sysdef.HANDLE; buf: in System.Address; count: in Sysdef.size_t) return Sysdef.ssize_t;
pragma Import (Stdcall, WriteFile, "WriteFile");
-- Common constants
INVALID_HANDLE: constant := -1;
ERROR_RETURN: constant := -1;
-- File record
type Posix_File_Record is new File_Record with record
Pool: Storage_Pool_Pointer := null;
Handle: Sysdef.int_t := INVALID_HANDLE;
end record;
type Posix_File_Pointer is access all Posix_File_Record;
-- Standard Files
Stdin: aliased Posix_File_Record := (null, 0);
Stdout: aliased Posix_File_Record := (null, 1);
Stderr: aliased Posix_File_Record := (null, 2);
function Flag_To_System (Bits: in Flag_Bits) return System_Word is
V: System_Word := 0;
begin
if ((Bits and FLAG_READ) /= 0) and then
((Bits and FLAG_WRITE) /= 0) then
V := V or Sysdef.O_RDWR;
elsif ((Bits and FLAG_WRITE) /= 0) then
V := V or Sysdef.O_WRONLY;
else
V := V or Sysdef.O_RDONLY;
end if;
if (Bits and FLAG_CREATE) /= 0 then
V := V or Sysdef.O_CREAT;
end if;
if (Bits and FLAG_TRUNCATE) /= 0 then
V := V or Sysdef.O_TRUNC;
end if;
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;
return V;
end Flag_To_System;
function Get_Stdin return File_Pointer is
begin
--return File_Pointer'(Stdin'Access);
return File_Record(Stdin)'Access;
end Get_Stdin;
function Get_Stdout return File_Pointer is
begin
--return File_Pointer'(Stdout'Access);
return File_Record(Stdout)'Access;
end Get_Stdout;
function Get_Stderr return File_Pointer is
begin
--return File_Pointer'(Stderr'Access);
return File_Record(Stdout)'Access;
end Get_Stderr;
procedure Open (File: out File_Pointer;
Name: in Slim_String;
Flag: in Flag_Record;
Mode: in Mode_Record := DEFAULT_MODE;
Pool: in Storage_Pool_Pointer := null) is
package P is new H2.Pool (Posix_File_Record, Posix_File_Pointer, Pool);
F: Posix_File_Pointer;
begin
F := P.Allocate;
F.Pool := Pool;
F.Handle := Sys_Open (Name & Slim_Character'Val(0),
Sysdef.int_t(Flag_To_System(Flag.Bits)),
Sysdef.int_t(Mode.Bits));
if Sysdef."<=" (F.Handle, INVALID_HANDLE) then
raise Constraint_Error; -- TODO: raise a proper exception.
end if;
File := File_Pointer(F);
end Open;
procedure Open (File: out File_Pointer;
Name: in Wide_String;
Flag: in Flag_Record;
Mode: in Mode_Record := DEFAULT_MODE;
Pool: in Storage_Pool_Pointer := null) is
begin
Open (File, Wide_To_Slim(Name), Flag, Mode, Pool);
end Open;
procedure Close (File: in out File_Pointer) is
F: Posix_File_Pointer := Posix_File_Pointer(File);
begin
if F /= Stdin'Access and then F /= Stdout'Access and then F /= Stderr'Access then
-- Don't close standard files.
Sys_Close (F.Handle);
F.Handle := INVALID_HANDLE;
declare
package P is new H2.Pool (Posix_File_Record, Posix_File_Pointer, F.Pool);
begin
P.Deallocate (F);
end;
File := null;
end if;
end Close;
procedure Read (File: in File_Pointer;
Buffer: 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
else
Length := System_Length(N);
end if;
end Read;
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
else
Length := System_Length(N);
end if;
end Write;
end File;

10
lib/win32/h2-sysdef.ads Normal file
View File

@ -0,0 +1,10 @@
with System;
package H2.Sysdef is
type PVOID is System.Address;
subtype HANDLE is PVOID;
type DWORD is mod 2 ** 32;
end H2.Sysdef;