OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2014-07-18 11:58:14 +02:00
parent 6128aad458
commit adc1de2527
8 changed files with 75 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
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>
* g-memdum.adb, g-memdum.ads (Dump): New parameter Prefix, defaulted

26
gcc/ada/a-witeio.adb
View File

@ -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;

6
gcc/ada/exp_strm.adb
View File

@ -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

6
gcc/ada/g-memdum.adb
View File

@ -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;

12
gcc/ada/g-memdum.ads
View File

@ -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;

11
gcc/ada/i-cstrea.ads
View File

@ -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");

5
gcc/ada/s-crtl.ads
View File

@ -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");

17
gcc/ada/sysdep.c
View File

@ -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)
{