Skip to content

R
riscv-gcc-1
Commit adc1de25 by Arnaud Charlet
Options

[multiple changes] 

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* g-memdum.adb, g-memdum.ads, exp_strm.adb: Minor reformatting.

2014-07-18  Pascal Obry  <obry@adacore.com>

	* 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.

From-SVN: r212800
parent 6128aad4
Showing with 75 additions and 19 deletions
gcc/ada/ChangeLog
2014-07-18 Robert Dewar <dewar@adacore.com>
* g-memdum.adb, g-memdum.ads, exp_strm.adb: Minor reformatting.
2014-07-18 Pascal Obry <obry@adacore.com>
* 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 <quinot@adacore.com> 2014-07-18 Thomas Quinot <quinot@adacore.com>
* g-memdum.adb, g-memdum.ads (Dump): New parameter Prefix, defaulted * g-memdum.adb, g-memdum.ads (Dump): New parameter Prefix, defaulted
......
gcc/ada/a-witeio.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1082,13 +1082,13 @@ package body Ada.Wide_Text_IO is ...@@ -1082,13 +1082,13 @@ package body Ada.Wide_Text_IO is
FIO.Check_Write_Status (AP (File)); FIO.Check_Write_Status (AP (File));
for K in 1 .. Spacing loop for K in 1 .. Spacing loop
Putc (LM, File); Put (File, Wide_Character'Val (LM));
File.Line := File.Line + 1; File.Line := File.Line + 1;
if File.Page_Length /= 0 if File.Page_Length /= 0
and then File.Line > File.Page_Length and then File.Line > File.Page_Length
then then
Putc (PM, File); Put (File, Wide_Character'Val (PM));
File.Line := 1; File.Line := 1;
File.Page := File.Page + 1; File.Page := File.Page + 1;
end if; end if;
...@@ -1220,6 +1220,14 @@ package body Ada.Wide_Text_IO is ...@@ -1220,6 +1220,14 @@ package body Ada.Wide_Text_IO is
(File : File_Type; (File : File_Type;
Item : Wide_Character) Item : Wide_Character)
is 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 Out_Char (C : Character);
-- Procedure to output one character of a wide character sequence -- Procedure to output one character of a wide character sequence
...@@ -1234,11 +1242,21 @@ package body Ada.Wide_Text_IO is ...@@ -1234,11 +1242,21 @@ package body Ada.Wide_Text_IO is
Putc (Character'Pos (C), File); Putc (Character'Pos (C), File);
end Out_Char; end Out_Char;
R : int;
pragma Unreferenced (R);
-- Start of processing for Put -- Start of processing for Put
begin begin
FIO.Check_Write_Status (AP (File)); 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; File.Col := File.Col + 1;
end Put; end Put;
......
gcc/ada/exp_strm.adb
...@@ -1254,9 +1254,9 @@ package body Exp_Strm is ...@@ -1254,9 +1254,9 @@ package body Exp_Strm is
Stms := New_List; Stms := New_List;
-- Note that of course there will be no discriminants for the elementary -- Note that of course there will be no discriminants for the elementary
-- type case, so Has_Discriminants will be False. Note that the -- type case, so Has_Discriminants will be False. Note that the language
-- language rules do not require writing the discriminants in the -- rules do not allow writing the discriminants in the defaulted case,
-- defaulted case, because those are written by 'Write. -- because those are written by 'Write.
if Has_Discriminants (Typ) if Has_Discriminants (Typ)
and then and then
......
gcc/ada/g-memdum.adb
...@@ -81,17 +81,21 @@ package body GNAT.Memory_Dump is ...@@ -81,17 +81,21 @@ package body GNAT.Memory_Dump is
case Prefix is case Prefix is
when Absolute_Address => when Absolute_Address =>
AIL := Address_Image_Length - 4 + 2; AIL := Address_Image_Length - 4 + 2;
when Offset => when Offset =>
Offset_Last := Offset_Buf'First - 1; Offset_Last := Offset_Buf'First - 1;
Set_Image_Based_Integer (Ctr, 16, 0, Offset_Buf, Offset_Last); Set_Image_Based_Integer (Ctr, 16, 0, Offset_Buf, Offset_Last);
AIL := Offset_Last - 4 + 2; AIL := Offset_Last - 4 + 2;
when None => when None =>
AIL := 0; AIL := 0;
end case; end case;
Line_Len := AIL + 3 * 16 + 2 + 16; Line_Len := AIL + 3 * 16 + 2 + 16;
declare declare
Line_Buf : String (1 .. Line_Len); Line_Buf : String (1 .. Line_Len);
begin begin
while Ctr /= 0 loop while Ctr /= 0 loop
...@@ -110,6 +114,7 @@ package body GNAT.Memory_Dump is ...@@ -110,6 +114,7 @@ package body GNAT.Memory_Dump is
declare declare
Last : Natural := 0; Last : Natural := 0;
Len : Natural; Len : Natural;
begin begin
Set_Image_Based_Integer Set_Image_Based_Integer
(Count - Ctr, 16, 0, Offset_Buf, Last); (Count - Ctr, 16, 0, Offset_Buf, Last);
...@@ -160,7 +165,6 @@ package body GNAT.Memory_Dump is ...@@ -160,7 +165,6 @@ package body GNAT.Memory_Dump is
GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N)); GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N));
end if; end if;
end; end;
end Dump; end Dump;
end GNAT.Memory_Dump; end GNAT.Memory_Dump;
gcc/ada/g-memdum.ads
...@@ -45,15 +45,17 @@ package GNAT.Memory_Dump is ...@@ -45,15 +45,17 @@ package GNAT.Memory_Dump is
Count : Natural; Count : Natural;
Prefix : Prefix_Type := Absolute_Address); Prefix : Prefix_Type := Absolute_Address);
-- Dumps indicated number (Count) of bytes, starting at the address given -- Dumps indicated number (Count) of bytes, starting at the address given
-- by Addr. The coding of this routine in its current form assumes the -- by Addr. The coding of this routine in its current form assumes the case
-- case of a byte addressable machine (and is therefore inapplicable to -- of a byte addressable machine (and is therefore inapplicable to machines
-- machines like the AAMP, where the storage unit is not 8 bits). The -- like the AAMP, where the storage unit is not 8 bits). The output is one
-- output is one or more lines in the following format, which is for the -- or more lines in the following format, which is for the case of 32-bit
-- case of 32-bit addresses (64-bit addresses are handled appropriately): -- addresses (64-bit addresses are handled appropriately):
-- --
-- 0234_3368: 66 67 68 . . . 73 74 75 "fghijklmnopqstuv" -- 0234_3368: 66 67 68 . . . 73 74 75 "fghijklmnopqstuv"
-- --
-- All but the last line have 16 bytes. A question mark is used in the -- All but the last line have 16 bytes. A question mark is used in the
-- string data to indicate a non-printable character. -- string data to indicate a non-printable character.
--
-- Please document Prefix ???
end GNAT.Memory_Dump; end GNAT.Memory_Dump;
gcc/ada/i-cstrea.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -119,6 +119,9 @@ package Interfaces.C_Streams is ...@@ -119,6 +119,9 @@ package Interfaces.C_Streams is
function fputc (C : int; stream : FILEs) return int function fputc (C : int; stream : FILEs) return int
renames System.CRTL.fputc; renames System.CRTL.fputc;
function fputwc (C : int; stream : FILEs) return int
renames System.CRTL.fputwc;
function fputs (Strng : chars; Stream : FILEs) return int function fputs (Strng : chars; Stream : FILEs) return int
renames System.CRTL.fputs; renames System.CRTL.fputs;
...@@ -223,8 +226,9 @@ package Interfaces.C_Streams is ...@@ -223,8 +226,9 @@ package Interfaces.C_Streams is
-- versa. These functions have no effect if text_translation_required 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. -- false (i.e. in normal unix mode). Use fileno to get a stream handle.
procedure set_binary_mode (handle : int); procedure set_binary_mode (handle : int);
procedure set_text_mode (handle : int); procedure set_text_mode (handle : int);
procedure set_wide_text_mode (handle : int);
---------------------------- ----------------------------
-- Full Path Name support -- -- Full Path Name support --
...@@ -256,6 +260,7 @@ private ...@@ -256,6 +260,7 @@ private
pragma Import (C, set_binary_mode, "__gnat_set_binary_mode"); pragma Import (C, set_binary_mode, "__gnat_set_binary_mode");
pragma Import (C, set_text_mode, "__gnat_set_text_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, max_path_len, "__gnat_max_path_len");
pragma Import (C, full_name, "__gnat_full_name"); pragma Import (C, full_name, "__gnat_full_name");
......
gcc/ada/s-crtl.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -122,6 +122,9 @@ package System.CRTL is ...@@ -122,6 +122,9 @@ package System.CRTL is
function fputc (C : int; stream : FILEs) return int; function fputc (C : int; stream : FILEs) return int;
pragma Import (C, fputc, "fputc"); 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; function fputs (Strng : chars; Stream : FILEs) return int;
pragma Import (C, fputs, "fputs"); pragma Import (C, fputs, "fputs");
......
gcc/ada/sysdep.c
...@@ -104,11 +104,12 @@ extern struct tm *localtime_r(const time_t *, struct tm *); ...@@ -104,11 +104,12 @@ extern struct tm *localtime_r(const time_t *, struct tm *);
file positioning function, unless the input operation encounters file positioning function, unless the input operation encounters
end-of-file. end-of-file.
The other target dependent declarations here are for the two functions The other target dependent declarations here are for the three functions
__gnat_set_binary_mode and __gnat_set_text_mode: __gnat_set_binary_mode, __gnat_set_text_mode and __gnat_set_wide_text_mode:
void __gnat_set_binary_mode (int handle); void __gnat_set_binary_mode (int handle);
void __gnat_set_text_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 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 no distinction between binary and text files), but in DOS (and similar
...@@ -150,6 +151,12 @@ __gnat_set_text_mode (int handle) ...@@ -150,6 +151,12 @@ __gnat_set_text_mode (int handle)
WIN_SETMODE (handle, O_TEXT); WIN_SETMODE (handle, O_TEXT);
} }
void
__gnat_set_wide_text_mode (int handle)
{
WIN_SETMODE (handle, _O_U16TEXT);
}
#ifdef __CYGWIN__ #ifdef __CYGWIN__
char * char *
...@@ -245,6 +252,12 @@ void ...@@ -245,6 +252,12 @@ void
__gnat_set_text_mode (int handle ATTRIBUTE_UNUSED) __gnat_set_text_mode (int handle ATTRIBUTE_UNUSED)
{ {
} }
void
__gnat_set_wide_text_mode (int handle ATTRIBUTE_UNUSED)
{
}
char * char *
__gnat_ttyname (int filedes) __gnat_ttyname (int filedes)
{ {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment