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); H2.Wide.Utf8.From_Unicode_String);
F: Sysapi.File_Pointer; F: Sysapi.File_Pointer;
M: Sysapi.Mode_Record; FL: Sysapi.File_Flag;
LG: Sysapi.Flag_Record;
begin 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); Sysapi.File.Close (F);
end; end;

2
lib/GNUmakefile.in
View File

@ -21,7 +21,7 @@ clean:
distclean: clean distclean: clean
ADAC := $(CC) ADAC := @CC@
ADAFLAGS := -x ada -gnatA -fPIC -gnata -gnato -gnatN -gnatwl -lgnat95 -gnatW8 -g ADAFLAGS := -x ada -gnatA -fPIC -gnata -gnato -gnatN -gnatwl -lgnat95 -gnatW8 -g
BINDFLAGS := -x -shared -n -Lh2 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); print (interp, q);
end; end;
goto SKIP; goto SKIP;
declare declare
A: aliased Object_Pointer; A: aliased Object_Pointer;
B: 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; 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; end H2.Sysapi;

61
lib/h2-sysapi.ads
View File

@ -9,33 +9,62 @@ generic
package H2.Sysapi is 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_Record is tagged null record;
type File_Pointer is access all File_Record'Class; type File_Pointer is access all File_Record'Class;
type File_Flag is ( type File_Flag_Bits is new System_Word;
RDONLY, type File_Flag is record
RDWR 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 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; procedure Open (File: out File_Pointer;
Name: in Slim_String; Name: in Slim_String;
Flag: in Flag_Record; Flag: in File_Flag;
Mode: in Mode_Record; Mode: in File_Mode := DEFAULT_FILE_MODE;
Pool: in Storage_Pool_Pointer := null); Pool: in Storage_Pool_Pointer := null);
procedure Open (File: out File_Pointer; procedure Open (File: out File_Pointer;
Name: in Wide_String; Name: in Wide_String;
Flag: in Flag_Record; Flag: in File_Flag;
Mode: in Mode_Record; Mode: in File_Mode := DEFAULT_FILE_MODE;
Pool: in Storage_Pool_Pointer := null); Pool: in Storage_Pool_Pointer := null);
procedure Close (File: in out File_Pointer); 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); procedure sys_close (fd: C.int);
pragma Import (C, sys_close, "close"); pragma Import (C, sys_close, "close");
INVALID_HANDLE: constant C.int := -1;
type Posix_File_Record is new File_Record with record type Posix_File_Record is new File_Record with record
Pool: Storage_Pool_Pointer := null; Pool: Storage_Pool_Pointer := null;
Handle: C.int := Interfaces.C."-"(1); Handle: C.int := INVALID_HANDLE;
end record; end record;
type Posix_File_Pointer is access all Posix_File_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 begin
return 0; -- if Bits and File_Flag_Read /= 0 then
end Flag_To_System; -- 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 return V;
begin end Flag_To_System;
return 0;
end Mode_To_System;
procedure Open (File: out File_Pointer; procedure Open (File: out File_Pointer;
Name: in Slim_String; Name: in Slim_String;
Flag: in Flag_Record; Flag: in File_Flag;
Mode: in Mode_Record; Mode: in File_Mode := DEFAULT_FILE_MODE;
Pool: in Storage_Pool_Pointer := null) is Pool: in Storage_Pool_Pointer := null) is
package P is new H2.Pool (Posix_File_Record, Posix_File_Pointer, Pool); 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.Pool := Pool;
--F.Handle := sys_open (Interfaces.C.char_array(Name & Slim.Character'Val(0)), 0, 0); --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 if F.Handle <= -1 then
raise Constraint_Error; -- TODO: raise a proper exception. raise Constraint_Error; -- TODO: raise a proper exception.
end if; end if;
@ -55,8 +60,8 @@ package body File is
procedure Open (File: out File_Pointer; procedure Open (File: out File_Pointer;
Name: in Wide_String; Name: in Wide_String;
Flag: in Flag_Record; Flag: in File_Flag;
Mode: in Mode_Record; Mode: in File_Mode := DEFAULT_FILE_MODE;
Pool: in Storage_Pool_Pointer := null) is Pool: in Storage_Pool_Pointer := null) is
begin begin
Open (File, Wide_To_Slim(Name), Flag, Mode, Pool); Open (File, Wide_To_Slim(Name), Flag, Mode, Pool);