added some input procedures
This commit is contained in:
@ -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;
|
||||
|
Reference in New Issue
Block a user