diff options
Diffstat (limited to 'gcc/ada/a-witeio.adb')
| -rw-r--r-- | gcc/ada/a-witeio.adb | 153 |
1 files changed, 91 insertions, 62 deletions
diff --git a/gcc/ada/a-witeio.adb b/gcc/ada/a-witeio.adb index e877405820f..efd5021849d 100644 --- a/gcc/ada/a-witeio.adb +++ b/gcc/ada/a-witeio.adb @@ -57,26 +57,62 @@ package body Ada.Wide_Text_IO is WC_Encoding : Character; pragma Import (C, WC_Encoding, "__gl_wc_encoding"); + -- Default wide character encoding + + Err_Name : aliased String := "*stderr" & ASCII.NUL; + In_Name : aliased String := "*stdin" & ASCII.NUL; + Out_Name : aliased String := "*stdout" & ASCII.NUL; + -- Names of standard files + -- + -- Use "preallocated" strings to avoid calling "new" during the elaboration + -- of the run time. This is needed in the tasking case to avoid calling + -- Task_Lock too early. A filename is expected to end with a null character + -- in the runtime, here the null characters are added just to have a + -- correct filename length. + -- + -- Note: the names for these files are bogus, and probably it would be + -- better for these files to have no names, but the ACVC tests insist! + -- We use names that are bound to fail in open etc. + + Null_Str : aliased constant String := ""; + -- Used as form string for standard files ----------------------- -- Local Subprograms -- ----------------------- - function Getc_Immed (File : File_Type) return int; - -- This routine is identical to Getc, except that the read is done in - -- Get_Immediate mode (i.e. without waiting for a line return). - function Get_Wide_Char_Immed (C : Character; File : File_Type) return Wide_Character; -- This routine is identical to Get_Wide_Char, except that the reads are -- done in Get_Immediate mode (i.e. without waiting for a line return). + function Getc_Immed (File : File_Type) return int; + -- This routine is identical to Getc, except that the read is done in + -- Get_Immediate mode (i.e. without waiting for a line return). + + procedure Putc (ch : int; File : File_Type); + -- Outputs the given character to the file, which has already been checked + -- for being in output status. Device_Error is raised if the character + -- cannot be written. + procedure Set_WCEM (File : in out File_Type); -- Called by Open and Create to set the wide character encoding method for -- the file, processing a WCEM form parameter if one is present. File is -- IN OUT because it may be closed in case of an error. + procedure Terminate_Line (File : File_Type); + -- If the file is in Write_File or Append_File mode, and the current line + -- is not terminated, then a line terminator is written using New_Line. + -- Note that there is no Terminate_Page routine, because the page mark at + -- the end of the file is implied if necessary. + + procedure Ungetc (ch : int; File : File_Type); + -- Pushes back character into stream, using ungetc. The caller has checked + -- that the file is in read status. Device_Error is raised if the character + -- cannot be pushed back. An attempt to push back and end of file character + -- (EOF) is ignored. + ------------------- -- AFCB_Allocate -- ------------------- @@ -843,6 +879,52 @@ package body Ada.Wide_Text_IO is return ch; end Getc_Immed; + ------------------------------- + -- Initialize_Standard_Files -- + ------------------------------- + + procedure Initialize_Standard_Files is + 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_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.Self := Standard_In; + 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.Self := Standard_Out; + Standard_Out.WC_Method := Default_WCEM; + + FIO.Make_Unbuffered (AP (Standard_Out)); + FIO.Make_Unbuffered (AP (Standard_Err)); + end Initialize_Standard_Files; + ------------- -- Is_Open -- ------------- @@ -856,9 +938,9 @@ package body Ada.Wide_Text_IO is -- Line -- ---------- - -- Note: we assume that it is impossible in practice for the line - -- to exceed the value of Count'Last, i.e. no check is required for - -- overflow raising layout error. + -- Note: we assume that it is impossible in practice for the line to exceed + -- the value of Count'Last, i.e. no check is required for overflow raising + -- layout error. function Line (File : File_Type) return Positive_Count is begin @@ -1840,20 +1922,8 @@ package body Ada.Wide_Text_IO is set_text_mode (fileno (File.Stream)); end Write; - -- Use "preallocated" strings to avoid calling "new" during the - -- elaboration of the run time. This is needed in the tasking case to - -- avoid calling Task_Lock too early. A filename is expected to end with - -- a null character in the runtime, here the null characters are added - -- just to have a correct filename length. - - Err_Name : aliased String := "*stderr" & ASCII.NUL; - In_Name : aliased String := "*stdin" & ASCII.NUL; - Out_Name : aliased String := "*stdout" & ASCII.NUL; - begin - ------------------------------- - -- Initialize Standard Files -- - ------------------------------- + -- Initialize Standard Files for J in WC_Encoding_Method loop if WC_Encoding = WC_Encoding_Letters (J) then @@ -1861,51 +1931,10 @@ begin end if; end loop; - -- Note: the names in these files are bogus, and probably it would be - -- better for these files to have no names, but the ACVC test insist! - -- We use names that are bound to fail in open etc. - - 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_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.Self := Standard_In; - 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.Self := Standard_Out; - Standard_Out.WC_Method := Default_WCEM; + Initialize_Standard_Files; 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; |