+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
-- --
-- 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- --
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;
(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
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;
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
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
declare
Last : Natural := 0;
Len : Natural;
+
begin
Set_Image_Based_Integer
(Count - Ctr, 16, 0, Offset_Buf, Last);
GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N));
end if;
end;
-
end Dump;
end GNAT.Memory_Dump;
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;
-- --
-- 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- --
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;
-- 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 --
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");
-- --
-- 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- --
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");
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
WIN_SETMODE (handle, O_TEXT);
}
+void
+__gnat_set_wide_text_mode (int handle)
+{
+ WIN_SETMODE (handle, _O_U16TEXT);
+}
+
#ifdef __CYGWIN__
char *
__gnat_set_text_mode (int handle ATTRIBUTE_UNUSED)
{
}
+
+void
+__gnat_set_wide_text_mode (int handle ATTRIBUTE_UNUSED)
+{
+}
+
char *
__gnat_ttyname (int filedes)
{
projects / gcc.git / commitdiff