with Ada.Streams; use Ada.Streams;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System;
with System.File_IO;
with System.CRTL;
with Unchecked_Conversion;
with Unchecked_Deallocation;
pragma Elaborate_All (System.File_IO);
package body Ada.Text_IO is
package FIO renames System.File_IO;
subtype AP is FCB.AFCB_Ptr;
function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type FCB.File_Mode;
use type System.CRTL.size_t;
function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr is
pragma Unreferenced (Control_Block);
begin
return new Text_AFCB;
end AFCB_Allocate;
procedure AFCB_Close (File : access Text_AFCB) is
begin
if File_Type (File) = Current_In then
Current_In := null;
elsif File_Type (File) = Current_Out then
Current_Out := null;
elsif File_Type (File) = Current_Err then
Current_Err := null;
end if;
Terminate_Line (File_Type (File));
end AFCB_Close;
procedure AFCB_Free (File : access Text_AFCB) is
type FCB_Ptr is access all Text_AFCB;
FT : FCB_Ptr := FCB_Ptr (File);
procedure Free is new Unchecked_Deallocation (Text_AFCB, FCB_Ptr);
begin
Free (FT);
end AFCB_Free;
procedure Close (File : in out File_Type) is
begin
FIO.Close (AP (File));
end Close;
function Col (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return File.Col;
end Col;
function Col return Positive_Count is
begin
return Col (Current_Out);
end Col;
procedure Create
(File : in out File_Type;
Mode : File_Mode := Out_File;
Name : String := "";
Form : String := "")
is
Dummy_File_Control_Block : Text_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
begin
FIO.Open (File_Ptr => AP (File),
Dummy_FCB => Dummy_File_Control_Block,
Mode => To_FCB (Mode),
Name => Name,
Form => Form,
Amethod => 'T',
Creat => True,
Text => True);
File.Self := File;
end Create;
function Current_Error return File_Type is
begin
return Current_Err;
end Current_Error;
function Current_Error return File_Access is
begin
return Current_Err.Self'Access;
end Current_Error;
function Current_Input return File_Type is
begin
return Current_In;
end Current_Input;
function Current_Input return File_Access is
begin
return Current_In.Self'Access;
end Current_Input;
function Current_Output return File_Type is
begin
return Current_Out;
end Current_Output;
function Current_Output return File_Access is
begin
return Current_Out.Self'Access;
end Current_Output;
procedure Delete (File : in out File_Type) is
begin
FIO.Delete (AP (File));
end Delete;
function End_Of_File (File : File_Type) return Boolean is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM then
if File.Before_LM_PM then
return Nextc (File) = EOF;
end if;
else
ch := Getc (File);
if ch = EOF then
return True;
elsif ch /= LM then
Ungetc (ch, File);
return False;
else File.Before_LM := True;
end if;
end if;
ch := Getc (File);
if ch = EOF then
return True;
elsif ch = PM and then File.Is_Regular_File then
File.Before_LM_PM := True;
return Nextc (File) = EOF;
else
Ungetc (ch, File);
return False;
end if;
end End_Of_File;
function End_Of_File return Boolean is
begin
return End_Of_File (Current_In);
end End_Of_File;
function End_Of_Line (File : File_Type) return Boolean is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM then
return True;
else
ch := Getc (File);
if ch = EOF then
return True;
else
Ungetc (ch, File);
return (ch = LM);
end if;
end if;
end End_Of_Line;
function End_Of_Line return Boolean is
begin
return End_Of_Line (Current_In);
end End_Of_Line;
function End_Of_Page (File : File_Type) return Boolean is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
if not File.Is_Regular_File then
return False;
elsif File.Before_LM then
if File.Before_LM_PM then
return True;
end if;
else
ch := Getc (File);
if ch = EOF then
return True;
elsif ch /= LM then
Ungetc (ch, File);
return False;
else File.Before_LM := True;
end if;
end if;
ch := Nextc (File);
return ch = PM or else ch = EOF;
end End_Of_Page;
function End_Of_Page return Boolean is
begin
return End_Of_Page (Current_In);
end End_Of_Page;
function EOF_Char return Integer is
begin
return EOF;
end EOF_Char;
procedure Flush (File : File_Type) is
begin
FIO.Flush (AP (File));
end Flush;
procedure Flush is
begin
Flush (Current_Out);
end Flush;
function Form (File : File_Type) return String is
begin
return FIO.Form (AP (File));
end Form;
procedure Get
(File : File_Type;
Item : out Character)
is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM then
File.Before_LM := False;
File.Col := 1;
if File.Before_LM_PM then
File.Line := 1;
File.Page := File.Page + 1;
File.Before_LM_PM := False;
else
File.Line := File.Line + 1;
end if;
end if;
loop
ch := Getc (File);
if ch = EOF then
raise End_Error;
elsif ch = LM then
File.Line := File.Line + 1;
File.Col := 1;
elsif ch = PM and then File.Is_Regular_File then
File.Page := File.Page + 1;
File.Line := 1;
else
Item := Character'Val (ch);
File.Col := File.Col + 1;
return;
end if;
end loop;
end Get;
procedure Get (Item : out Character) is
begin
Get (Current_In, Item);
end Get;
procedure Get
(File : File_Type;
Item : out String)
is
ch : int;
J : Natural;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
File.Col := 1;
if File.Before_LM_PM then
File.Line := 1;
File.Page := File.Page + 1;
File.Before_LM_PM := False;
else
File.Line := File.Line + 1;
end if;
end if;
J := Item'First;
while J <= Item'Last loop
ch := Getc (File);
if ch = EOF then
raise End_Error;
elsif ch = LM then
File.Line := File.Line + 1;
File.Col := 1;
elsif ch = PM and then File.Is_Regular_File then
File.Page := File.Page + 1;
File.Line := 1;
else
Item (J) := Character'Val (ch);
J := J + 1;
File.Col := File.Col + 1;
end if;
end loop;
end Get;
procedure Get (Item : out String) is
begin
Get (Current_In, Item);
end Get;
procedure Get_Immediate
(File : File_Type;
Item : out Character)
is
ch : int;
end_of_file : int;
procedure getc_immediate
(stream : FILEs;
ch : out int;
end_of_file : out int);
pragma Import (C, getc_immediate, "getc_immediate");
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
ch := LM;
else
getc_immediate (File.Stream, ch, end_of_file);
if ferror (File.Stream) /= 0 then
raise Device_Error;
elsif end_of_file /= 0 then
raise End_Error;
end if;
end if;
Item := Character'Val (ch);
end Get_Immediate;
procedure Get_Immediate
(Item : out Character)
is
begin
Get_Immediate (Current_In, Item);
end Get_Immediate;
procedure Get_Immediate
(File : File_Type;
Item : out Character;
Available : out Boolean)
is
ch : int;
end_of_file : int;
avail : int;
procedure getc_immediate_nowait
(stream : FILEs;
ch : out int;
end_of_file : out int;
avail : out int);
pragma Import (C, getc_immediate_nowait, "getc_immediate_nowait");
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
Available := True;
Item := Character'Val (LM);
else
getc_immediate_nowait (File.Stream, ch, end_of_file, avail);
if ferror (File.Stream) /= 0 then
raise Device_Error;
elsif end_of_file /= 0 then
raise End_Error;
elsif avail = 0 then
Available := False;
Item := ASCII.NUL;
else
Available := True;
Item := Character'Val (ch);
end if;
end if;
end Get_Immediate;
procedure Get_Immediate
(Item : out Character;
Available : out Boolean)
is
begin
Get_Immediate (Current_In, Item, Available);
end Get_Immediate;
procedure Get_Line
(File : File_Type;
Item : out String;
Last : out Natural)
is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
Last := Item'First - 1;
if Last >= Item'Last then
return;
end if;
if File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
else
ch := Getc (File);
if ch = EOF then
raise End_Error;
end if;
loop
exit when ch = LM;
Last := Last + 1;
Item (Last) := Character'Val (ch);
if Last = Item'Last then
File.Col := File.Col + Count (Item'Length);
return;
end if;
ch := Getc (File);
exit when ch = EOF;
end loop;
end if;
File.Line := File.Line + 1;
File.Col := 1;
if File.Before_LM_PM then
File.Line := 1;
File.Before_LM_PM := False;
File.Page := File.Page + 1;
elsif File.Is_Regular_File then
ch := Getc (File);
if ch = PM and then File.Is_Regular_File then
File.Line := 1;
File.Page := File.Page + 1;
else
Ungetc (ch, File);
end if;
end if;
end Get_Line;
procedure Get_Line
(Item : out String;
Last : out Natural)
is
begin
Get_Line (Current_In, Item, Last);
end Get_Line;
function Get_Line (File : File_Type) return String is
Buffer : String (1 .. 500);
Last : Natural;
function Get_Rest (S : String) return String;
function Get_Rest (S : String) return String is
Buffer : String (1 .. S'Length);
Last : Natural;
begin
Get_Line (File, Buffer, Last);
declare
R : constant String := S & Buffer (1 .. Last);
begin
if Last < Buffer'Last then
return R;
else
return Get_Rest (R);
end if;
end;
end Get_Rest;
begin
Get_Line (File, Buffer, Last);
if Last < Buffer'Last then
return Buffer (1 .. Last);
else
return Get_Rest (Buffer (1 .. Last));
end if;
end Get_Line;
function Get_Line return String is
begin
return Get_Line (Current_In);
end Get_Line;
function Getc (File : File_Type) return int is
ch : int;
begin
ch := fgetc (File.Stream);
if ch = EOF and then ferror (File.Stream) /= 0 then
raise Device_Error;
else
return ch;
end if;
end Getc;
function Is_Open (File : File_Type) return Boolean is
begin
return FIO.Is_Open (AP (File));
end Is_Open;
function Line (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return File.Line;
end Line;
function Line return Positive_Count is
begin
return Line (Current_Out);
end Line;
function Line_Length (File : File_Type) return Count is
begin
FIO.Check_Write_Status (AP (File));
return File.Line_Length;
end Line_Length;
function Line_Length return Count is
begin
return Line_Length (Current_Out);
end Line_Length;
procedure Look_Ahead
(File : File_Type;
Item : out Character;
End_Of_Line : out Boolean)
is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM then
End_Of_Line := True;
Item := ASCII.NUL;
else
ch := Nextc (File);
if ch = LM
or else ch = EOF
or else (ch = PM and then File.Is_Regular_File)
then
End_Of_Line := True;
Item := ASCII.NUL;
else
End_Of_Line := False;
Item := Character'Val (ch);
end if;
end if;
end Look_Ahead;
procedure Look_Ahead
(Item : out Character;
End_Of_Line : out Boolean)
is
begin
Look_Ahead (Current_In, Item, End_Of_Line);
end Look_Ahead;
function Mode (File : File_Type) return File_Mode is
begin
return To_TIO (FIO.Mode (AP (File)));
end Mode;
function Name (File : File_Type) return String is
begin
return FIO.Name (AP (File));
end Name;
procedure New_Line
(File : File_Type;
Spacing : Positive_Count := 1)
is
begin
if Spacing not in Positive_Count then
raise Constraint_Error;
end if;
FIO.Check_Write_Status (AP (File));
for K in 1 .. Spacing loop
Putc (LM, File);
File.Line := File.Line + 1;
if File.Page_Length /= 0
and then File.Line > File.Page_Length
then
Putc (PM, File);
File.Line := 1;
File.Page := File.Page + 1;
end if;
end loop;
File.Col := 1;
end New_Line;
procedure New_Line (Spacing : Positive_Count := 1) is
begin
New_Line (Current_Out, Spacing);
end New_Line;
procedure New_Page (File : File_Type) is
begin
FIO.Check_Write_Status (AP (File));
if File.Col /= 1 or else File.Line = 1 then
Putc (LM, File);
end if;
Putc (PM, File);
File.Page := File.Page + 1;
File.Line := 1;
File.Col := 1;
end New_Page;
procedure New_Page is
begin
New_Page (Current_Out);
end New_Page;
function Nextc (File : File_Type) return int is
ch : int;
begin
ch := fgetc (File.Stream);
if ch = EOF then
if ferror (File.Stream) /= 0 then
raise Device_Error;
end if;
else
if ungetc (ch, File.Stream) = EOF then
raise Device_Error;
end if;
end if;
return ch;
end Nextc;
procedure Open
(File : in out File_Type;
Mode : File_Mode;
Name : String;
Form : String := "")
is
Dummy_File_Control_Block : Text_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
begin
FIO.Open (File_Ptr => AP (File),
Dummy_FCB => Dummy_File_Control_Block,
Mode => To_FCB (Mode),
Name => Name,
Form => Form,
Amethod => 'T',
Creat => False,
Text => True);
File.Self := File;
end Open;
function Page (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return File.Page;
end Page;
function Page return Positive_Count is
begin
return Page (Current_Out);
end Page;
function Page_Length (File : File_Type) return Count is
begin
FIO.Check_Write_Status (AP (File));
return File.Page_Length;
end Page_Length;
function Page_Length return Count is
begin
return Page_Length (Current_Out);
end Page_Length;
procedure Put
(File : File_Type;
Item : Character)
is
begin
FIO.Check_Write_Status (AP (File));
if File.Line_Length /= 0 and then File.Col > File.Line_Length then
New_Line (File);
end if;
if fputc (Character'Pos (Item), File.Stream) = EOF then
raise Device_Error;
end if;
File.Col := File.Col + 1;
end Put;
procedure Put (Item : Character) is
begin
FIO.Check_Write_Status (AP (Current_Out));
if Current_Out.Line_Length /= 0
and then Current_Out.Col > Current_Out.Line_Length
then
New_Line (Current_Out);
end if;
if fputc (Character'Pos (Item), Current_Out.Stream) = EOF then
raise Device_Error;
end if;
Current_Out.Col := Current_Out.Col + 1;
end Put;
procedure Put
(File : File_Type;
Item : String)
is
begin
FIO.Check_Write_Status (AP (File));
if Item'Length > 0 then
if File.Line_Length /= 0 then
for J in Item'Range loop
Put (File, Item (J));
end loop;
else
FIO.Write_Buf (AP (File), Item'Address, Item'Length);
File.Col := File.Col + Item'Length;
end if;
end if;
end Put;
procedure Put (Item : String) is
begin
Put (Current_Out, Item);
end Put;
procedure Put_Line
(File : File_Type;
Item : String)
is
Ilen : Natural := Item'Length;
Istart : Natural := Item'First;
begin
FIO.Check_Write_Status (AP (File));
if File.Line_Length /= 0 then
Put (File, Item);
New_Line (File);
return;
end if;
if Ilen > 512 then
FIO.Write_Buf (AP (File), Item'Address, size_t (Ilen - 512));
Istart := Istart + Ilen - 512;
Ilen := 512;
end if;
declare
Buffer : String (1 .. Ilen + 2);
Plen : size_t;
begin
Buffer (1 .. Ilen) := Item (Istart .. Item'Last);
Buffer (Ilen + 1) := Character'Val (LM);
if File.Page_Length /= 0
and then File.Line > File.Page_Length
then
Buffer (Ilen + 2) := Character'Val (PM);
Plen := size_t (Ilen) + 2;
File.Line := 1;
File.Page := File.Page + 1;
else
Plen := size_t (Ilen) + 1;
File.Line := File.Line + 1;
end if;
FIO.Write_Buf (AP (File), Buffer'Address, Plen);
File.Col := 1;
end;
end Put_Line;
procedure Put_Line (Item : String) is
begin
Put_Line (Current_Out, Item);
end Put_Line;
procedure Putc (ch : int; File : File_Type) is
begin
if fputc (ch, File.Stream) = EOF then
raise Device_Error;
end if;
end Putc;
procedure Read
(File : in out Text_AFCB;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
Discard_ch : int;
pragma Warnings (Off, Discard_ch);
begin
if File.Mode /= FCB.In_File then
raise Mode_Error;
end if;
if File.Before_LM then
if File.Before_LM_PM then
Discard_ch := ungetc (PM, File.Stream);
File.Before_LM_PM := False;
end if;
File.Before_LM := False;
Item (Item'First) := Stream_Element (Character'Pos (ASCII.LF));
if Item'Length = 1 then
Last := Item'Last;
else
Last :=
Item'First +
Stream_Element_Offset
(fread (buffer => Item'Address,
index => size_t (Item'First + 1),
size => 1,
count => Item'Length - 1,
stream => File.Stream));
end if;
return;
end if;
set_binary_mode (fileno (File.Stream));
Last :=
Item'First +
Stream_Element_Offset
(fread (Item'Address, 1, Item'Length, File.Stream)) - 1;
if Last < Item'Last then
if ferror (File.Stream) /= 0 then
raise Device_Error;
end if;
end if;
set_text_mode (fileno (File.Stream));
end Read;
procedure Reset
(File : in out File_Type;
Mode : File_Mode)
is
begin
if (File = Current_In or else
File = Current_Out or else
File = Current_Error)
and then To_FCB (Mode) /= File.Mode
then
raise Mode_Error;
end if;
Terminate_Line (File);
FIO.Reset (AP (File), To_FCB (Mode));
File.Page := 1;
File.Line := 1;
File.Col := 1;
File.Line_Length := 0;
File.Page_Length := 0;
File.Before_LM := False;
File.Before_LM_PM := False;
end Reset;
procedure Reset (File : in out File_Type) is
begin
Terminate_Line (File);
FIO.Reset (AP (File));
File.Page := 1;
File.Line := 1;
File.Col := 1;
File.Line_Length := 0;
File.Page_Length := 0;
File.Before_LM := False;
File.Before_LM_PM := False;
end Reset;
procedure Set_Col
(File : File_Type;
To : Positive_Count)
is
ch : int;
begin
if To not in Positive_Count then
raise Constraint_Error;
end if;
FIO.Check_File_Open (AP (File));
if To = File.Col then
return;
end if;
if Mode (File) >= Out_File then
if File.Line_Length /= 0 and then To > File.Line_Length then
raise Layout_Error;
end if;
if To < File.Col then
New_Line (File);
end if;
while File.Col < To loop
Put (File, ' ');
end loop;
else
loop
ch := Getc (File);
if ch = EOF then
raise End_Error;
elsif ch = LM then
File.Line := File.Line + 1;
File.Col := 1;
elsif ch = PM and then File.Is_Regular_File then
File.Page := File.Page + 1;
File.Line := 1;
File.Col := 1;
elsif To = File.Col then
Ungetc (ch, File);
return;
else
File.Col := File.Col + 1;
end if;
end loop;
end if;
end Set_Col;
procedure Set_Col (To : Positive_Count) is
begin
Set_Col (Current_Out, To);
end Set_Col;
procedure Set_Error (File : File_Type) is
begin
FIO.Check_Write_Status (AP (File));
Current_Err := File;
end Set_Error;
procedure Set_Input (File : File_Type) is
begin
FIO.Check_Read_Status (AP (File));
Current_In := File;
end Set_Input;
procedure Set_Line
(File : File_Type;
To : Positive_Count)
is
begin
if To not in Positive_Count then
raise Constraint_Error;
end if;
FIO.Check_File_Open (AP (File));
if To = File.Line then
return;
end if;
if Mode (File) >= Out_File then
if File.Page_Length /= 0 and then To > File.Page_Length then
raise Layout_Error;
end if;
if To < File.Line then
New_Page (File);
end if;
while File.Line < To loop
New_Line (File);
end loop;
else
while To /= File.Line loop
Skip_Line (File);
end loop;
end if;
end Set_Line;
procedure Set_Line (To : Positive_Count) is
begin
Set_Line (Current_Out, To);
end Set_Line;
procedure Set_Line_Length (File : File_Type; To : Count) is
begin
if To not in Count then
raise Constraint_Error;
end if;
FIO.Check_Write_Status (AP (File));
File.Line_Length := To;
end Set_Line_Length;
procedure Set_Line_Length (To : Count) is
begin
Set_Line_Length (Current_Out, To);
end Set_Line_Length;
procedure Set_Output (File : File_Type) is
begin
FIO.Check_Write_Status (AP (File));
Current_Out := File;
end Set_Output;
procedure Set_Page_Length (File : File_Type; To : Count) is
begin
if To not in Count then
raise Constraint_Error;
end if;
FIO.Check_Write_Status (AP (File));
File.Page_Length := To;
end Set_Page_Length;
procedure Set_Page_Length (To : Count) is
begin
Set_Page_Length (Current_Out, To);
end Set_Page_Length;
procedure Skip_Line
(File : File_Type;
Spacing : Positive_Count := 1)
is
ch : int;
begin
if Spacing not in Positive_Count then
raise Constraint_Error;
end if;
FIO.Check_Read_Status (AP (File));
for L in 1 .. Spacing loop
if File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
else
ch := Getc (File);
if ch = EOF then
raise End_Error;
end if;
loop
exit when ch = LM or ch = EOF;
ch := Getc (File);
end loop;
end if;
File.Col := 1;
File.Line := File.Line + 1;
if File.Before_LM_PM then
File.Page := File.Page + 1;
File.Line := 1;
File.Before_LM_PM := False;
elsif File.Is_Regular_File then
ch := Getc (File);
if (ch = PM or else ch = EOF)
and then File.Is_Regular_File
then
File.Page := File.Page + 1;
File.Line := 1;
else
Ungetc (ch, File);
end if;
end if;
end loop;
end Skip_Line;
procedure Skip_Line (Spacing : Positive_Count := 1) is
begin
Skip_Line (Current_In, Spacing);
end Skip_Line;
procedure Skip_Page (File : File_Type) is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_LM_PM then
File.Before_LM := False;
File.Before_LM_PM := False;
File.Page := File.Page + 1;
File.Line := 1;
File.Col := 1;
return;
end if;
if File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
ch := Getc (File);
else
ch := Getc (File);
if ch = EOF then
raise End_Error;
end if;
end if;
loop
exit when ch = EOF
or else (ch = PM and then File.Is_Regular_File);
ch := Getc (File);
end loop;
File.Page := File.Page + 1;
File.Line := 1;
File.Col := 1;
end Skip_Page;
procedure Skip_Page is
begin
Skip_Page (Current_In);
end Skip_Page;
function Standard_Error return File_Type is
begin
return Standard_Err;
end Standard_Error;
function Standard_Error return File_Access is
begin
return Standard_Err'Access;
end Standard_Error;
function Standard_Input return File_Type is
begin
return Standard_In;
end Standard_Input;
function Standard_Input return File_Access is
begin
return Standard_In'Access;
end Standard_Input;
function Standard_Output return File_Type is
begin
return Standard_Out;
end Standard_Output;
function Standard_Output return File_Access is
begin
return Standard_Out'Access;
end Standard_Output;
procedure Terminate_Line (File : File_Type) is
begin
FIO.Check_File_Open (AP (File));
if Mode (File) /= In_File then
if File.Col /= 1 then
New_Line (File);
elsif (File /= Standard_Err and then File /= Standard_Out)
and then (File.Line = 1 and then File.Page = 1)
and then Mode (File) = Out_File
then
New_Line (File);
end if;
end if;
end Terminate_Line;
procedure Ungetc (ch : int; File : File_Type) is
begin
if ch /= EOF then
if ungetc (ch, File.Stream) = EOF then
raise Device_Error;
end if;
end if;
end Ungetc;
procedure Write
(File : in out Text_AFCB;
Item : Stream_Element_Array)
is
function Has_Translated_Characters return Boolean;
text_translation_required : Boolean;
pragma Import (C, text_translation_required,
"__gnat_text_translation_required");
Siz : constant size_t := Item'Length;
function Has_Translated_Characters return Boolean is
begin
for K in Item'Range loop
if Item (K) = 10 then
return True;
end if;
end loop;
return False;
end Has_Translated_Characters;
Needs_Binary_Write : constant Boolean :=
text_translation_required and then Has_Translated_Characters;
begin
if File.Mode = FCB.In_File then
raise Mode_Error;
end if;
if Needs_Binary_Write then
if fflush (File.Stream) = -1 then
raise Device_Error;
end if;
set_binary_mode (fileno (File.Stream));
end if;
if fwrite (Item'Address, 1, Siz, File.Stream) /= Siz then
raise Device_Error;
end if;
if Needs_Binary_Write then
if fflush (File.Stream) = -1 then
raise Device_Error;
end if;
set_text_mode (fileno (File.Stream));
end if;
end Write;
Err_Name : aliased String := "*stderr" & ASCII.Nul;
In_Name : aliased String := "*stdin" & ASCII.Nul;
Out_Name : aliased String := "*stdout" & ASCII.Nul;
begin
Standard_Err.Stream := stderr;
Standard_Err.Name := Err_Name'Access;
Standard_Err.Form := Null_Str'Unrestricted_Access;
Standard_Err.Mode := FCB.Out_File;
Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0;
Standard_Err.Is_Temporary_File := False;
Standard_Err.Is_System_File := True;
Standard_Err.Is_Text_File := True;
Standard_Err.Access_Method := 'T';
Standard_Err.Self := Standard_Err;
Standard_In.Stream := stdin;
Standard_In.Name := In_Name'Access;
Standard_In.Form := Null_Str'Unrestricted_Access;
Standard_In.Mode := FCB.In_File;
Standard_In.Is_Regular_File := is_regular_file (fileno (stdin)) /= 0;
Standard_In.Is_Temporary_File := False;
Standard_In.Is_System_File := True;
Standard_In.Is_Text_File := True;
Standard_In.Access_Method := 'T';
Standard_In.Self := Standard_In;
Standard_Out.Stream := stdout;
Standard_Out.Name := Out_Name'Access;
Standard_Out.Form := Null_Str'Unrestricted_Access;
Standard_Out.Mode := FCB.Out_File;
Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0;
Standard_Out.Is_Temporary_File := False;
Standard_Out.Is_System_File := True;
Standard_Out.Is_Text_File := True;
Standard_Out.Access_Method := 'T';
Standard_Out.Self := Standard_Out;
FIO.Chain_File (AP (Standard_In));
FIO.Chain_File (AP (Standard_Out));
FIO.Chain_File (AP (Standard_Err));
FIO.Make_Unbuffered (AP (Standard_Out));
FIO.Make_Unbuffered (AP (Standard_Err));
end Ada.Text_IO;