with Ada.Exceptions; use Ada.Exceptions;
with Ada.Streams; use Ada.Streams;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System;
with System.CRTL;
with System.File_IO;
with System.WCh_Cnv; use System.WCh_Cnv;
with System.WCh_Con; use System.WCh_Con;
with Unchecked_Conversion;
with Unchecked_Deallocation;
pragma Elaborate_All (System.File_IO);
package body Ada.Wide_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;
WC_Encoding : Character;
pragma Import (C, WC_Encoding, "__gl_wc_encoding");
function Getc_Immed (File : File_Type) return int;
function Get_Wide_Char_Immed
(C : Character;
File : File_Type) return Wide_Character;
procedure Set_WCEM (File : in out File_Type);
function AFCB_Allocate
(Control_Block : Wide_Text_AFCB) return FCB.AFCB_Ptr
is
pragma Unreferenced (Control_Block);
begin
return new Wide_Text_AFCB;
end AFCB_Allocate;
procedure AFCB_Close (File : access Wide_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 Wide_Text_AFCB) is
type FCB_Ptr is access all Wide_Text_AFCB;
FT : FCB_Ptr := FCB_Ptr (File);
procedure Free is new Unchecked_Deallocation (Wide_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 : Wide_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 => 'W',
Creat => True,
Text => True);
Set_WCEM (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'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'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'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_Wide_Character then
return False;
elsif 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_Wide_Character then
return False;
elsif 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_Wide_Character 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;
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 Wide_Character)
is
C : Character;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_Wide_Character then
File.Before_Wide_Character := False;
Item := File.Saved_Wide_Character;
else
Get_Character (File, C);
Item := Get_Wide_Char (C, File);
end if;
end Get;
procedure Get (Item : out Wide_Character) is
begin
Get (Current_In, Item);
end Get;
procedure Get
(File : File_Type;
Item : out Wide_String)
is
begin
for J in Item'Range loop
Get (File, Item (J));
end loop;
end Get;
procedure Get (Item : out Wide_String) is
begin
Get (Current_In, Item);
end Get;
procedure Get_Character
(File : File_Type;
Item : out Character)
is
ch : int;
begin
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;
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_Character;
procedure Get_Immediate
(File : File_Type;
Item : out Wide_Character)
is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
if File.Before_Wide_Character then
File.Before_Wide_Character := False;
Item := File.Saved_Wide_Character;
elsif File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
Item := Wide_Character'Val (LM);
else
ch := Getc_Immed (File);
if ch = EOF then
raise End_Error;
else
Item := Get_Wide_Char_Immed (Character'Val (ch), File);
end if;
end if;
end Get_Immediate;
procedure Get_Immediate
(Item : out Wide_Character)
is
begin
Get_Immediate (Current_In, Item);
end Get_Immediate;
procedure Get_Immediate
(File : File_Type;
Item : out Wide_Character;
Available : out Boolean)
is
ch : int;
begin
FIO.Check_Read_Status (AP (File));
Available := True;
if File.Before_Wide_Character then
File.Before_Wide_Character := False;
Item := File.Saved_Wide_Character;
elsif File.Before_LM then
File.Before_LM := False;
File.Before_LM_PM := False;
Item := Wide_Character'Val (LM);
else
ch := Getc_Immed (File);
if ch = EOF then
raise End_Error;
else
Item := Get_Wide_Char_Immed (Character'Val (ch), File);
end if;
end if;
end Get_Immediate;
procedure Get_Immediate
(Item : out Wide_Character;
Available : out Boolean)
is
begin
Get_Immediate (Current_In, Item, Available);
end Get_Immediate;
procedure Get_Line
(File : File_Type;
Item : out Wide_String;
Last : out Natural)
is
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
if Nextc (File) = EOF then
raise End_Error;
end if;
loop
if End_Of_Line (File) then
Skip_Line (File);
return;
end if;
Last := Last + 1;
Get (File, Item (Last));
if Last = Item'Last then
File.Col := File.Col + Count (Item'Length);
return;
end if;
exit when Nextc (File) = EOF;
end loop;
end if;
end Get_Line;
procedure Get_Line
(Item : out Wide_String;
Last : out Natural)
is
begin
Get_Line (Current_In, Item, Last);
end Get_Line;
function Get_Line (File : File_Type) return Wide_String is
Buffer : Wide_String (1 .. 500);
Last : Natural;
function Get_Rest (S : Wide_String) return Wide_String;
function Get_Rest (S : Wide_String) return Wide_String is
Buffer : Wide_String (1 .. S'Length);
Last : Natural;
begin
Get_Line (File, Buffer, Last);
declare
R : constant Wide_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 Wide_String is
begin
return Get_Line (Current_In);
end Get_Line;
function Get_Wide_Char
(C : Character;
File : File_Type) return Wide_Character
is
function In_Char return Character;
function WC_In is new Char_Sequence_To_Wide_Char (In_Char);
function In_Char return Character is
ch : constant Integer := Getc (File);
begin
if ch = EOF then
raise End_Error;
else
return Character'Val (ch);
end if;
end In_Char;
begin
return WC_In (C, File.WC_Method);
end Get_Wide_Char;
function Get_Wide_Char_Immed
(C : Character;
File : File_Type) return Wide_Character
is
function In_Char return Character;
function WC_In is new Char_Sequence_To_Wide_Char (In_Char);
function In_Char return Character is
ch : constant Integer := Getc_Immed (File);
begin
if ch = EOF then
raise End_Error;
else
return Character'Val (ch);
end if;
end In_Char;
begin
return WC_In (C, File.WC_Method);
end Get_Wide_Char_Immed;
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 Getc_Immed (File : File_Type) return int 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
return EOF;
end if;
end if;
return ch;
end Getc_Immed;
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 Wide_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 := Wide_Character'Val (0);
elsif File.Before_Wide_Character then
End_Of_Line := False;
Item := File.Saved_Wide_Character;
else
ch := Getc (File);
if ch = LM
or else ch = EOF
or else (ch = EOF and then File.Is_Regular_File)
then
End_Of_Line := True;
Ungetc (ch, File);
Item := Wide_Character'Val (0);
elsif ch <= 16#0080# then
End_Of_Line := False;
Ungetc (ch, File);
Item := Wide_Character'Val (ch);
else
Item := Get_Wide_Char (Character'Val (ch), File);
End_Of_Line := False;
File.Saved_Wide_Character := Item;
File.Before_Wide_Character := True;
end if;
end if;
end Look_Ahead;
procedure Look_Ahead
(Item : out Wide_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 : Wide_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 => 'W',
Creat => False,
Text => True);
Set_WCEM (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 : Wide_Character)
is
procedure Out_Char (C : Character);
procedure WC_Out is new Wide_Char_To_Char_Sequence (Out_Char);
procedure Out_Char (C : Character) is
begin
Putc (Character'Pos (C), File);
end Out_Char;
begin
WC_Out (Item, File.WC_Method);
File.Col := File.Col + 1;
end Put;
procedure Put (Item : Wide_Character) is
begin
Put (Current_Out, Item);
end Put;
procedure Put
(File : File_Type;
Item : Wide_String)
is
begin
for J in Item'Range loop
Put (File, Item (J));
end loop;
end Put;
procedure Put (Item : Wide_String) is
begin
Put (Current_Out, Item);
end Put;
procedure Put_Line
(File : File_Type;
Item : Wide_String)
is
begin
Put (File, Item);
New_Line (File);
end Put_Line;
procedure Put_Line (Item : Wide_String) is
begin
Put (Current_Out, Item);
New_Line (Current_Out);
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 Wide_Text_AFCB;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
Discard_ch : int;
pragma Unreferenced (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 Set_WCEM (File : in out File_Type) is
Start : Natural;
Stop : Natural;
begin
File.WC_Method := WCEM_Brackets;
FIO.Form_Parameter (File.Form.all, "wcem", Start, Stop);
if Start = 0 then
File.WC_Method := WCEM_Brackets;
elsif Start /= 0 then
if Stop = Start then
for J in WC_Encoding_Letters'Range loop
if File.Form (Start) = WC_Encoding_Letters (J) then
File.WC_Method := J;
return;
end if;
end loop;
end if;
Close (File);
Raise_Exception (Use_Error'Identity, "invalid WCEM form parameter");
end if;
end Set_WCEM;
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;
File.Before_Wide_Character := False;
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;
File.Before_Wide_Character := False;
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)
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 Wide_Text_AFCB;
Item : Stream_Element_Array)
is
Siz : constant size_t := Item'Length;
begin
if File.Mode = FCB.In_File then
raise Mode_Error;
end if;
set_binary_mode (fileno (File.Stream));
if fwrite (Item'Address, 1, Siz, File.Stream) /= Siz then
raise Device_Error;
end if;
set_text_mode (fileno (File.Stream));
end Write;
Err_Name : aliased String := "*stderr" & ASCII.Nul;
In_Name : aliased String := "*stdin" & ASCII.Nul;
Out_Name : aliased String := "*stdout" & ASCII.Nul;
begin
for J in WC_Encoding_Method loop
if WC_Encoding = WC_Encoding_Letters (J) then
Default_WCEM := J;
end if;
end loop;
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.WC_Method := Default_WCEM;
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.WC_Method := Default_WCEM;
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.WC_Method := Default_WCEM;
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.Wide_Text_IO;