hcl/lib/posix/h2-sysapi-file.adb

87 lines
2.2 KiB
Ada

with Interfaces.C;
with H2.Pool;
separate (H2.Sysapi)
package body File is
package C renames Interfaces.C;
use type C.int;
--function sys_open (path: ; flags: C.int; mode: C.int) return C.int;
function sys_open (path: Slim_String; flags: C.int; mode: C.int) return C.int;
pragma Import (C, sys_open, "open");
procedure sys_close (fd: C.int);
pragma Import (C, sys_close, "close");
INVALID_HANDLE: constant C.int := -1;
type Posix_File_Record is new File_Record with record
Pool: Storage_Pool_Pointer := null;
Handle: C.int := INVALID_HANDLE;
end record;
type Posix_File_Pointer is access all Posix_File_Record;
function Flag_To_System (Bits: in File_Flag_Bits) return C.int is
V: C.int := 0;
begin
-- if Bits and File_Flag_Read /= 0 then
-- V := V or 0;
-- end if;
-- if Bits and File_Flag_Write /= 0 then
-- V := V or 1;
-- end if;
return V;
end Flag_To_System;
procedure Open (File: out File_Pointer;
Name: in Slim_String;
Flag: in File_Flag;
Mode: in File_Mode := DEFAULT_FILE_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 (Interfaces.C.char_array(Name & Slim.Character'Val(0)), 0, 0);
F.Handle := sys_open (Name, Flag_To_System(Flag.Bits), C.int(Mode.Bits));
if F.Handle <= -1 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 File_Flag;
Mode: in File_Mode := DEFAULT_FILE_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;
begin
F := Posix_File_Pointer(File);
sys_close (F.Handle);
F.Handle := Interfaces.C."-"(1);
declare
package P is new H2.Pool (Posix_File_Record, Posix_File_Pointer, F.Pool);
begin
P.Deallocate (F);
end;
File := null;
end Close;
end File;