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

added some file constants

Browse Source
This commit is contained in:
hyung-hwan 2014-06-02 15:25:42 +00:00
parent b11eedcaa2
commit 9c971cd841
6 changed files with 232 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
cmd/scheme.adb
View File

@ -50,10 +50,11 @@ declare
H2.Wide.Utf8.From_Unicode_String);
F: Sysapi.File_Pointer;
M: Sysapi.Mode_Record;
LG: Sysapi.Flag_Record;
FL: Sysapi.File_Flag;
begin
Sysapi.File.Open (F, H2.Slim.String'("/etc/passwd"), LG, M);
Sysapi.Set_File_Flag_Bits (FL, Sysapi.FILE_FLAG_WRITE);
Sysapi.Set_File_Flag_Bits (FL, Sysapi.FILE_FLAG_READ);
Sysapi.File.Open (F, H2.Slim.String'("/etc/passwd"), FL);
Sysapi.File.Close (F);
end;

2
lib/GNUmakefile.in
View File

@ -21,7 +21,7 @@ clean:
distclean: clean
ADAC := $(CC)
ADAC := @CC@
ADAFLAGS := -x ada -gnatA -fPIC -gnata -gnato -gnatN -gnatwl -lgnat95 -gnatW8 -g
BINDFLAGS := -x -shared -n -Lh2

1
lib/h2-scheme.adb
View File

@ -2687,6 +2687,7 @@ q := bigint.to_string (interp.self, q, 10);
print (interp, q);
end;
goto SKIP;
declare
A: aliased Object_Pointer;
B: aliased Object_Pointer;

10
lib/h2-sysapi.adb
View File

@ -2,4 +2,14 @@ package body H2.Sysapi is
package body File is separate;
procedure Set_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits) is
begin
Flag.Bits := Flag.Bits or Bits;
end Set_File_Flag_Bits;
procedure Clear_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits) is
begin
Flag.Bits := Flag.Bits and not Bits;
end Clear_File_Flag_Bits;
end H2.Sysapi;

61
lib/h2-sysapi.ads
View File

@ -9,33 +9,62 @@ generic
package H2.Sysapi is
type Flag_Record is record
x: integer;
end record;
type Mode_Record is record
x: integer;
end record;
type File_Record is tagged null record;
type File_Pointer is access all File_Record'Class;
type File_Flag is (
RDONLY,
RDWR
);
type File_Flag_Bits is new System_Word;
type File_Flag is record
Bits: File_Flag_Bits := 0;
end record;
type File_Mode_Bits is new System_Word;
type File_Mode is record
Bits: File_Mode_Bits := 0;
end record;
FILE_FLAG_READ: constant File_Flag_Bits := 2#0000_0000_0000_0001#;
FILE_FLAG_WRITE: constant File_Flag_Bits := 2#0000_0000_0000_0010#;
FILE_FLAG_CREATE: constant File_Flag_Bits := 2#0000_0000_0000_0100#;
FILE_FLAG_EXCLUSIVE: constant File_Flag_Bits := 2#0000_0000_0000_1000#;
FILE_FLAG_TRUNCATE: constant File_Flag_Bits := 2#0000_0000_0001_0000#;
FILE_FLAG_APPEND: constant File_Flag_Bits := 2#0000_0000_0010_0000#;
FILE_FLAG_NONBLOCK: constant File_Flag_Bits := 2#0000_0000_0100_0000#;
FILE_FLAG_SYNC: constant File_Flag_Bits := 2#0000_0000_1000_0000#;
FILE_FLAG_NOFOLLOW: constant File_Flag_Bits := 2#0000_0001_0000_0000#;
-- FILE_FLAG_NOSHREAD: constant File_Flag_Bits := 2#0010_0000_0000_0000#;
-- FILE_FLAG_NOSHWRITE: constant File_Flag_Bits := 2#0100_0000_0000_0000#;
-- FILE_FLAG_NOSHDELETE: constant File_Flag_Bits := 2#1000_0000_0000_0000#;
FILE_MODE_OWNER_READ: constant File_Mode_Bits := 2#100_000_000#;
FILE_MODE_OWNER_WRITE: constant File_Mode_Bits := 2#010_000_000#;
FILE_MODE_OWNER_EXEC: constant File_Mode_Bits := 2#001_000_000#;
FILE_MODE_GROUP_READ: constant File_Mode_Bits := 2#000_100_000#;
FILE_MODE_GROUP_WRITE: constant File_Mode_Bits := 2#000_010_000#;
FILE_MODE_GROUP_EXEC: constant File_Mode_Bits := 2#000_001_000#;
FILE_MODE_OTHER_READ: constant File_Mode_Bits := 2#000_000_100#;
FILE_MODE_OTHER_WRITE: constant File_Mode_Bits := 2#000_000_010#;
FILE_MODE_OTHER_EXEC: constant File_Mode_Bits := 2#000_000_001#;
DEFAULT_FILE_MODE: constant File_Mode := ( Bits => 2#110_100_100# );
procedure Set_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits);
procedure Clear_File_Flag_Bits (Flag: in out File_Flag; Bits: in File_Flag_Bits);
package File is
--type Handle_Record is tagged null record;
--type Handle_Pointer is access all Handle_Record'Class;
procedure Open (File: out File_Pointer;
Name: in Slim_String;
Flag: in Flag_Record;
Mode: in Mode_Record;
Flag: in File_Flag;
Mode: in File_Mode := DEFAULT_FILE_MODE;
Pool: in Storage_Pool_Pointer := null);
procedure Open (File: out File_Pointer;
Name: in Wide_String;
Flag: in Flag_Record;
Mode: in Mode_Record;
Flag: in File_Flag;
Mode: in File_Mode := DEFAULT_FILE_MODE;
Pool: in Storage_Pool_Pointer := null);
procedure Close (File: in out File_Pointer);

31
lib/posix/h2-sysapi-file.adb
View File

@ -15,26 +15,31 @@ package body File is
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 := Interfaces.C."-"(1);
Handle: C.int := INVALID_HANDLE;
end record;
type Posix_File_Pointer is access all Posix_File_Record;
function Flag_To_System (Flag: in Flag_Record) return C.int is
function Flag_To_System (Bits: in File_Flag_Bits) return C.int is
V: C.int := 0;
begin
return 0;
end Flag_To_System;
-- 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;
function Mode_To_System (Mode: in Mode_Record) return C.int is
begin
return 0;
end Mode_To_System;
return V;
end Flag_To_System;
procedure Open (File: out File_Pointer;
Name: in Slim_String;
Flag: in Flag_Record;
Mode: in Mode_Record;
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);
@ -45,7 +50,7 @@ package body File is
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), Mode_To_System(Mode));
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;
@ -55,8 +60,8 @@ package body File is
procedure Open (File: out File_Pointer;
Name: in Wide_String;
Flag: in Flag_Record;
Mode: in Mode_Record;
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);