From: charlet Date: Fri, 18 Jul 2014 09:58:14 +0000 (+0000) Subject: 2014-07-18 Robert Dewar X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=6670fda50c04fe71743e787a0ccc2318482e08e7;p=thirdparty%2Fgcc.git 2014-07-18 Robert Dewar * g-memdum.adb, g-memdum.ads, exp_strm.adb: Minor reformatting. 2014-07-18 Pascal Obry * s-crtl.ads, i-cstrea.ads (fputwc): New routine. * a-witeio.adb (Put): On platforms where there is translation done by the OS output the raw text. (New_Line): Use Put above to properly handle the LM wide characters. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212800 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 05d2da05f782..59ad09f051dc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2014-07-18 Robert Dewar + + * g-memdum.adb, g-memdum.ads, exp_strm.adb: Minor reformatting. + +2014-07-18 Pascal Obry + + * s-crtl.ads, i-cstrea.ads (fputwc): New routine. + * a-witeio.adb (Put): On platforms where there is translation + done by the OS output the raw text. + (New_Line): Use Put above to properly handle the LM wide characters. + 2014-07-18 Thomas Quinot * g-memdum.adb, g-memdum.ads (Dump): New parameter Prefix, defaulted diff --git a/gcc/ada/a-witeio.adb b/gcc/ada/a-witeio.adb index 045705448b89..b1d2bef5ed7f 100644 --- a/gcc/ada/a-witeio.adb +++ b/gcc/ada/a-witeio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1082,13 +1082,13 @@ package body Ada.Wide_Text_IO is FIO.Check_Write_Status (AP (File)); for K in 1 .. Spacing loop - Putc (LM, File); + Put (File, Wide_Character'Val (LM)); File.Line := File.Line + 1; if File.Page_Length /= 0 and then File.Line > File.Page_Length then - Putc (PM, File); + Put (File, Wide_Character'Val (PM)); File.Line := 1; File.Page := File.Page + 1; end if; @@ -1220,6 +1220,14 @@ package body Ada.Wide_Text_IO is (File : File_Type; Item : Wide_Character) is + text_translation_required : Boolean; + for text_translation_required'Size use Character'Size; + pragma Import (C, text_translation_required, + "__gnat_text_translation_required"); + -- Text translation is required on Windows only. This means that the + -- console is doing translation and we do not want to do any encoding + -- here. If this boolean is set we just output the character as-is. + procedure Out_Char (C : Character); -- Procedure to output one character of a wide character sequence @@ -1234,11 +1242,21 @@ package body Ada.Wide_Text_IO is Putc (Character'Pos (C), File); end Out_Char; + R : int; + pragma Unreferenced (R); + -- Start of processing for Put begin FIO.Check_Write_Status (AP (File)); - WC_Out (Item, File.WC_Method); + + if text_translation_required then + set_wide_text_mode (fileno (File.Stream)); + R := fputwc (Wide_Character'Pos (Item), File.Stream); + else + WC_Out (Item, File.WC_Method); + end if; + File.Col := File.Col + 1; end Put; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 288b1bfe30b9..1ffe9a51d97e 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -1254,9 +1254,9 @@ package body Exp_Strm is Stms := New_List; -- Note that of course there will be no discriminants for the elementary - -- type case, so Has_Discriminants will be False. Note that the - -- language rules do not require writing the discriminants in the - -- defaulted case, because those are written by 'Write. + -- type case, so Has_Discriminants will be False. Note that the language + -- rules do not allow writing the discriminants in the defaulted case, + -- because those are written by 'Write. if Has_Discriminants (Typ) and then diff --git a/gcc/ada/g-memdum.adb b/gcc/ada/g-memdum.adb index 31564c5b9f2a..9d7b25c785fb 100644 --- a/gcc/ada/g-memdum.adb +++ b/gcc/ada/g-memdum.adb @@ -81,17 +81,21 @@ package body GNAT.Memory_Dump is case Prefix is when Absolute_Address => AIL := Address_Image_Length - 4 + 2; + when Offset => Offset_Last := Offset_Buf'First - 1; Set_Image_Based_Integer (Ctr, 16, 0, Offset_Buf, Offset_Last); AIL := Offset_Last - 4 + 2; + when None => AIL := 0; end case; + Line_Len := AIL + 3 * 16 + 2 + 16; declare Line_Buf : String (1 .. Line_Len); + begin while Ctr /= 0 loop @@ -110,6 +114,7 @@ package body GNAT.Memory_Dump is declare Last : Natural := 0; Len : Natural; + begin Set_Image_Based_Integer (Count - Ctr, 16, 0, Offset_Buf, Last); @@ -160,7 +165,6 @@ package body GNAT.Memory_Dump is GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N)); end if; end; - end Dump; end GNAT.Memory_Dump; diff --git a/gcc/ada/g-memdum.ads b/gcc/ada/g-memdum.ads index 919663cf5e35..840fc92b5c27 100644 --- a/gcc/ada/g-memdum.ads +++ b/gcc/ada/g-memdum.ads @@ -45,15 +45,17 @@ package GNAT.Memory_Dump is Count : Natural; Prefix : Prefix_Type := Absolute_Address); -- Dumps indicated number (Count) of bytes, starting at the address given - -- by Addr. The coding of this routine in its current form assumes the - -- case of a byte addressable machine (and is therefore inapplicable to - -- machines like the AAMP, where the storage unit is not 8 bits). The - -- output is one or more lines in the following format, which is for the - -- case of 32-bit addresses (64-bit addresses are handled appropriately): + -- by Addr. The coding of this routine in its current form assumes the case + -- of a byte addressable machine (and is therefore inapplicable to machines + -- like the AAMP, where the storage unit is not 8 bits). The output is one + -- or more lines in the following format, which is for the case of 32-bit + -- addresses (64-bit addresses are handled appropriately): -- -- 0234_3368: 66 67 68 . . . 73 74 75 "fghijklmnopqstuv" -- -- All but the last line have 16 bytes. A question mark is used in the -- string data to indicate a non-printable character. + -- + -- Please document Prefix ??? end GNAT.Memory_Dump; diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads index 95dae64361e6..a2d6ab0056d2 100644 --- a/gcc/ada/i-cstrea.ads +++ b/gcc/ada/i-cstrea.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1995-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -119,6 +119,9 @@ package Interfaces.C_Streams is function fputc (C : int; stream : FILEs) return int renames System.CRTL.fputc; + function fputwc (C : int; stream : FILEs) return int + renames System.CRTL.fputwc; + function fputs (Strng : chars; Stream : FILEs) return int renames System.CRTL.fputs; @@ -223,8 +226,9 @@ package Interfaces.C_Streams is -- versa. These functions have no effect if text_translation_required is -- false (i.e. in normal unix mode). Use fileno to get a stream handle. - procedure set_binary_mode (handle : int); - procedure set_text_mode (handle : int); + procedure set_binary_mode (handle : int); + procedure set_text_mode (handle : int); + procedure set_wide_text_mode (handle : int); ---------------------------- -- Full Path Name support -- @@ -256,6 +260,7 @@ private pragma Import (C, set_binary_mode, "__gnat_set_binary_mode"); pragma Import (C, set_text_mode, "__gnat_set_text_mode"); + pragma Import (C, set_wide_text_mode, "__gnat_set_wide_text_mode"); pragma Import (C, max_path_len, "__gnat_max_path_len"); pragma Import (C, full_name, "__gnat_full_name"); diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index e2fe289156fe..0e809ab4fa20 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -122,6 +122,9 @@ package System.CRTL is function fputc (C : int; stream : FILEs) return int; pragma Import (C, fputc, "fputc"); + function fputwc (C : int; stream : FILEs) return int; + pragma Import (C, fputwc, "fputwc"); + function fputs (Strng : chars; Stream : FILEs) return int; pragma Import (C, fputs, "fputs"); diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index 43550cd894b7..9e129460a548 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -104,11 +104,12 @@ extern struct tm *localtime_r(const time_t *, struct tm *); file positioning function, unless the input operation encounters end-of-file. - The other target dependent declarations here are for the two functions - __gnat_set_binary_mode and __gnat_set_text_mode: + The other target dependent declarations here are for the three functions + __gnat_set_binary_mode, __gnat_set_text_mode and __gnat_set_wide_text_mode: void __gnat_set_binary_mode (int handle); void __gnat_set_text_mode (int handle); + void __gnat_set_wide_text_mode (int handle); These functions have no effect in Unix (or similar systems where there is no distinction between binary and text files), but in DOS (and similar @@ -150,6 +151,12 @@ __gnat_set_text_mode (int handle) WIN_SETMODE (handle, O_TEXT); } +void +__gnat_set_wide_text_mode (int handle) +{ + WIN_SETMODE (handle, _O_U16TEXT); +} + #ifdef __CYGWIN__ char * @@ -245,6 +252,12 @@ void __gnat_set_text_mode (int handle ATTRIBUTE_UNUSED) { } + +void +__gnat_set_wide_text_mode (int handle ATTRIBUTE_UNUSED) +{ +} + char * __gnat_ttyname (int filedes) {