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

added some input procedures

Browse Source
This commit is contained in:
hyung-hwan
2014-01-01 14:07:03 +00:00
parent eac1df647a
commit dd9a5a9a2e
6 changed files with 328 additions and 245 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
cmd/scheme.adb
View File

@ -15,57 +15,34 @@ procedure scheme is
O: S.Object_Pointer;
--String: aliased S.Object_String := "(car '(1 2 3))";
String: aliased S.Object_String := "((lambda (x y) (+ x y)) 9 7)";
String: aliased constant S.Object_String := "((lambda (x y) (+ x y)) 9 7)";
String_Stream: Stream.String_Input_Stream_Record (String'Unchecked_Access);
--String_Stream: Stream.String_Input_Stream_Record := (Len => String'Length, Str => String, Pos => 0);
File_Name: aliased S.Object_String := "test.adb";
--File_Name: aliased S.Object_String := "test.adb";
File_Name: aliased constant S.Object_String := "test.adb";
--File_Stream: Stream.File_Stream_Record (File_Name'Unchecked_Access);
--File_Stream: Stream.File_Stream_Record := (Name => File_Name'Unchecked_Access);
File_Stream: Stream.File_Stream_Record;
procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
Name: access S.Object_String;
Result: in out S.Stream_Pointer) is
subtype FSR is Stream.File_Stream_Record;
type FSP is access all FSR;
package P is new H2.Pool (FSR, FSP);
X: FSP;
for X'Address use Result'Address;
pragma Import (Ada, X);
begin
X := P.Allocate (S.Get_Storage_Pool(Interp));
X.Name := Stream.Object_String_Pointer(Name);
end Allocate_Stream;
procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
Source: in out S.Stream_Pointer) is
subtype FSR is Stream.File_Stream_Record;
type FSP is access all FSR;
package P is new H2.Pool (FSR, FSP);
X: FSP;
for X'Address use Source'Address;
pragma Import (Ada, X);
begin
P.Deallocate (X, S.Get_Storage_Pool(Interp));
end Deallocate_Stream;
-- --procedure Dealloc_Stream is new Ada.Unchecked_Deallocation (Stream_Record'Class, Stream_Pointer);
-- --procedure Destroy_Stream (Stream: in out Stream_Pointer) renames Dealloc_Stream;
begin
Ada.Text_Io.Put_Line (S.Object_Word'Image(S.Object_Pointer_Bytes));
S.Open (SI, 2_000_000, Pool'Unchecked_Access);
--S.Open (SI, null);
File_Stream.Name := File_Name'Unchecked_Access;
S.Set_Input_Stream (SI, File_Stream); -- specify main input stream
--S.Set_Output_Stream (SI, Stream); -- specify main output stream.
-- Specify the named stream handler
S.Set_Option (SI, (S.Stream_Option,
Stream.Allocate_Stream'Access,
Stream.Deallocate_Stream'Access)
);
File_Stream.Name := File_Name'Unchecked_Access;
S.Set_Input_Stream (SI, File_Stream); -- specify main input stream
--S.Set_Input_Stream (SI, String_Stream);
--S.Set_Output_Stream (SI, Stream); -- specify main output stream.
S.Read (SI, I);
S.Make_Test_Object (SI, I);
@ -107,5 +84,4 @@ S.Print (SI, O);
Ada.Text_IO.Put_Line ("BYE...");
end scheme;

45
cmd/stream.adb
View File

@ -1,3 +1,5 @@
with H2.Pool;
with Ada.Characters.Conversions;
package body Stream is
@ -5,13 +7,13 @@ package body Stream is
procedure Open (Stream: in out String_Input_Stream_Record) is
begin
Ada.Text_IO.Put_Line ("OPEN STRING STREAM");
Ada.Wide_Text_IO.Put_Line ("****** OPEN STRING STREAM ******");
Stream.Pos := 0;
end Open;
procedure Close (Stream: in out String_Input_Stream_Record) is
begin
Ada.Text_IO.Put_Line ("CLOSE STRING STREAM");
Ada.Wide_Text_IO.Put_Line ("****** CLOSE STRING STREAM ******");
Stream.Pos := Stream.Str'Last;
end Close;
@ -47,14 +49,14 @@ Ada.Text_IO.Put_Line ("CLOSE STRING STREAM");
procedure Open (Stream: in out File_Stream_Record) is
begin
Ada.Text_IO.Put_Line ("OPEN File STREAM");
Ada.Text_IO.Open (Stream.Handle, Ada.Text_IO.In_File, Stream.Name.all);
Ada.Wide_Text_IO.Put_Line (">>>>> OPEN File STREAM <<<<<");
Ada.Wide_Text_IO.Open (Stream.Handle, Ada.Wide_Text_IO.In_File, Ada.Characters.Conversions.To_String(Stream.Name.all));
end Open;
procedure Close (Stream: in out File_Stream_Record) is
begin
Ada.Text_IO.Put_Line ("CLOSE File STREAM");
Ada.Text_IO.Close (Stream.Handle);
Ada.Wide_Text_IO.Put_Line (">>>>> CLOSE File STREAM <<<<<");
Ada.Wide_Text_IO.Close (Stream.Handle);
end Close;
procedure Read (Stream: in out File_Stream_Record;
@ -63,9 +65,9 @@ Ada.Text_IO.Put_Line ("CLOSE File STREAM");
begin
for I in Data'First .. Data'Last loop
begin
Ada.Text_IO.Get_Immediate (Stream.Handle, Data(I));
Ada.Wide_Text_IO.Get_Immediate (Stream.Handle, Data(I));
exception
when Ada.Text_IO.End_Error =>
when Ada.Wide_Text_IO.End_Error =>
Last := I - 1;
return;
-- other exceptions must be just raised to indicate errors
@ -84,4 +86,31 @@ Ada.Text_IO.Put_Line ("CLOSE File STREAM");
------------------------------------------------------------------
procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
Name: in S.Constant_Object_String_Pointer;
Result: out S.Stream_Pointer) is
subtype FSR is Stream.File_Stream_Record;
type FSP is access all FSR;
package P is new H2.Pool (FSR, FSP);
X: FSP;
for X'Address use Result'Address;
pragma Import (Ada, X);
begin
X := P.Allocate (S.Get_Storage_Pool(Interp));
X.Name := Name;
end Allocate_Stream;
procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
Source: in out S.Stream_Pointer) is
subtype FSR is Stream.File_Stream_Record;
type FSP is access all FSR;
package P is new H2.Pool (FSR, FSP);
X: FSP;
for X'Address use Source'Address;
pragma Import (Ada, X);
begin
P.Deallocate (X, S.Get_Storage_Pool(Interp));
end Deallocate_Stream;
end Stream;

26
cmd/stream.ads
View File

@ -1,12 +1,13 @@
with H2.Scheme;
with Ada.Text_IO;
with Ada.Wide_Text_IO;
package Stream is
package S renames H2.Scheme;
------------------------------------------------------------
type Object_String_Pointer is access all S.Object_String;
--type Object_String_Pointer is access all S.Object_String;
type Object_String_Pointer is access constant S.Object_String;
type String_Input_Stream_Record(Str: Object_String_Pointer) is new S.Stream_Record with record
Pos: Standard.Natural := 0;
end record;
@ -27,14 +28,15 @@ package Stream is
------------------------------------------------------------
--type File_Stream_Record(Name: Object_String_Pointer) is new S.Stream_Record with record
-- Handle: Ada.Text_IO.File_Type;
-- Handle: H2.Text_IO.File_Type;
--end record;
type File_Stream_Record is new S.Stream_Record with record
Name: Object_String_Pointer;
Handle: Ada.Text_IO.File_Type;
Name: S.Constant_Object_String_Pointer;
Handle: Ada.Wide_Text_IO.File_Type;
end record;
procedure Open (Stream: in out File_Stream_Record);
procedure Close (Stream: in out File_Stream_Record);
procedure Read (Stream: in out File_Stream_Record;
@ -44,5 +46,19 @@ package Stream is
Data: out S.Object_String;
Last: out Standard.Natural);
------------------------------------------------------------
procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
Name: in S.Constant_Object_String_Pointer;
Result: out S.Stream_Pointer);
procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
Source: in out S.Stream_Pointer);
--private
-- type File_Stream_Record is new S.Stream_Record with record
-- Name: S.Constant_Object_String_Pointer;
-- Handle: Ada.Wide_Text_IO.File_Type;
-- end record;
end Stream;