public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-2027] [Ada] Remove Ada.Strings.Text_Output and child units
@ 2021-07-05 13:15 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-07-05 13:15 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:7e7397265c805a8d6623aadc039e898fea4a4be0
commit r12-2027-g7e7397265c805a8d6623aadc039e898fea4a4be0
Author: Steve Baird <baird@adacore.com>
Date: Thu Apr 29 14:54:54 2021 -0700
[Ada] Remove Ada.Strings.Text_Output and child units
gcc/ada/
* libgnat/a-stobbu.adb, libgnat/a-stobbu.ads,
libgnat/a-stobfi.adb, libgnat/a-stobfi.ads,
libgnat/a-stoubu.adb, libgnat/a-stoubu.ads,
libgnat/a-stoufi.adb, libgnat/a-stoufi.ads,
libgnat/a-stoufo.adb, libgnat/a-stoufo.ads,
libgnat/a-stouut.adb, libgnat/a-stouut.ads,
libgnat/a-stteou.ads: Delete files.
* Makefile.rtl, impunit.adb: Remove references to deleted files.
Diff:
---
gcc/ada/Makefile.rtl | 7 --
gcc/ada/impunit.adb | 6 -
gcc/ada/libgnat/a-stobbu.adb | 53 ---------
gcc/ada/libgnat/a-stobbu.ads | 34 ------
gcc/ada/libgnat/a-stobfi.adb | 118 -------------------
gcc/ada/libgnat/a-stobfi.ads | 66 -----------
gcc/ada/libgnat/a-stoubu.adb | 148 -----------------------
gcc/ada/libgnat/a-stoubu.ads | 73 ------------
gcc/ada/libgnat/a-stoufi.adb | 123 -------------------
gcc/ada/libgnat/a-stoufi.ads | 72 ------------
gcc/ada/libgnat/a-stoufo.adb | 155 ------------------------
gcc/ada/libgnat/a-stoufo.ads | 72 ------------
gcc/ada/libgnat/a-stouut.adb | 272 -------------------------------------------
gcc/ada/libgnat/a-stouut.ads | 107 -----------------
gcc/ada/libgnat/a-stteou.ads | 193 ------------------------------
15 files changed, 1499 deletions(-)
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index ff462004f50..d712ab5320d 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -275,13 +275,7 @@ GNATRTL_NONTASKING_OBJS= \
a-stboha$(objext) \
a-stfiha$(objext) \
a-stmaco$(objext) \
- a-stobbu$(objext) \
- a-stobfi$(objext) \
a-storio$(objext) \
- a-stoubu$(objext) \
- a-stoufi$(objext) \
- a-stoufo$(objext) \
- a-stouut$(objext) \
a-strbou$(objext) \
a-stream$(objext) \
a-strsto$(objext) \
@@ -295,7 +289,6 @@ GNATRTL_NONTASKING_OBJS= \
a-strsup$(objext) \
a-strunb$(objext) \
a-ststio$(objext) \
- a-stteou$(objext) \
a-sttebu$(objext) \
a-stbuun$(objext) \
a-stbubo$(objext) \
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index 7e4a4d9cd76..b99f3fd8ba0 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -635,12 +635,6 @@ package body Impunit is
("a-sttebu", T), -- Ada.Strings.Text_Buffers
("a-stbuun", T), -- Ada.Strings.Text_Buffers.Unbounded
("a-stbubo", T), -- Ada.Strings.Text_Buffers.Bounded
- ("a-stteou", T), -- Ada.Strings.Text_Output
- ("a-stouut", T), -- Ada.Strings.Text_Output.Utils
- ("a-stoufi", T), -- Ada.Strings.Text_Output.Files
- ("a-stobfi", T), -- Ada.Strings.Text_Output.Basic_Files
- ("a-stobbu", T), -- Ada.Strings.Text_Output.Bit_Buckets
- ("a-stoufo", T), -- Ada.Strings.Text_Output.Formatting
("a-strsto", T), -- Ada.Streams.Storage
("a-ststbo", T), -- Ada.Streams.Storage.Bounded
("a-ststun", T), -- Ada.Streams.Storage.Unbounded
diff --git a/gcc/ada/libgnat/a-stobbu.adb b/gcc/ada/libgnat/a-stobbu.adb
deleted file mode 100644
index 560fab21314..00000000000
--- a/gcc/ada/libgnat/a-stobbu.adb
+++ /dev/null
@@ -1,53 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.BIT_BUCKETS --
--- --
--- B o d y --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-package body Ada.Strings.Text_Output.Bit_Buckets is
-
- type Bit_Bucket_Type is new Sink with null record;
- overriding procedure Full_Method (S : in out Bit_Bucket_Type);
- overriding procedure Flush_Method (S : in out Bit_Bucket_Type);
-
- The_Bit_Bucket : aliased Bit_Bucket_Type
- (Chunk_Length => Default_Chunk_Length);
- function Bit_Bucket return Sink_Access is (The_Bit_Bucket'Access);
-
- overriding procedure Full_Method (S : in out Bit_Bucket_Type)
- renames Flush_Method;
-
- overriding procedure Flush_Method (S : in out Bit_Bucket_Type) is
- begin
- S.Last := 0;
- end Flush_Method;
-
-begin
- The_Bit_Bucket.Indent_Amount := 0;
- The_Bit_Bucket.Cur_Chunk := The_Bit_Bucket.Initial_Chunk'Access;
-end Ada.Strings.Text_Output.Bit_Buckets;
diff --git a/gcc/ada/libgnat/a-stobbu.ads b/gcc/ada/libgnat/a-stobbu.ads
deleted file mode 100644
index b8710d0bdc9..00000000000
--- a/gcc/ada/libgnat/a-stobbu.ads
+++ /dev/null
@@ -1,34 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.BIT_BUCKETS --
--- --
--- S p e c --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-package Ada.Strings.Text_Output.Bit_Buckets is
- function Bit_Bucket return Sink_Access;
-end Ada.Strings.Text_Output.Bit_Buckets;
diff --git a/gcc/ada/libgnat/a-stobfi.adb b/gcc/ada/libgnat/a-stobfi.adb
deleted file mode 100644
index 942f1518229..00000000000
--- a/gcc/ada/libgnat/a-stobfi.adb
+++ /dev/null
@@ -1,118 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.BASIC_FILES --
--- --
--- B o d y --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Strings.Text_Output.Utils; use Ada.Strings.Text_Output.Utils;
-package body Ada.Strings.Text_Output.Basic_Files is
- use type OS.File_Descriptor;
-
- function Create_From_FD
- (FD : OS.File_Descriptor;
- Indent_Amount : Natural;
- Chunk_Length : Positive) return File;
- -- Create a file from an OS file descriptor
-
- function Create_From_FD
- (FD : OS.File_Descriptor;
- Indent_Amount : Natural;
- Chunk_Length : Positive) return File
- is
- begin
- if FD = OS.Invalid_FD then
- raise Program_Error with OS.Errno_Message;
- end if;
- return Result : File (Chunk_Length) do
- Result.Indent_Amount := Indent_Amount;
- Result.Cur_Chunk := Result.Initial_Chunk'Unchecked_Access;
- Result.FD := FD;
- end return;
- end Create_From_FD;
-
- function Create_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File
- is
- begin
- return Create_From_FD
- (OS.Create_File (Name, Fmode => OS.Binary),
- Indent_Amount, Chunk_Length);
- end Create_File;
-
- function Create_New_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File
- is
- begin
- return Create_From_FD
- (OS.Create_New_File (Name, Fmode => OS.Binary),
- Indent_Amount, Chunk_Length);
- end Create_New_File;
-
- procedure Close (S : in out File'Class) is
- Status : Boolean;
- begin
- Flush (S);
-
- if S.FD not in OS.Standout | OS.Standerr then -- Don't close these
- OS.Close (S.FD, Status);
- if not Status then
- raise Program_Error with OS.Errno_Message;
- end if;
- end if;
- end Close;
-
- overriding procedure Full_Method (S : in out File) renames Flush_Method;
-
- overriding procedure Flush_Method (S : in out File) is
- pragma Assert (S.Cur_Chunk = S.Initial_Chunk'Unchecked_Access);
- Res : constant Integer :=
- OS.Write (S.FD, S.Cur_Chunk.Chars'Address, S.Last);
- begin
- if Res /= S.Last then
- raise Program_Error with OS.Errno_Message;
- end if;
- S.Last := 0;
- end Flush_Method;
-
- The_Stdout : aliased File :=
- Create_From_FD (OS.Standout,
- Indent_Amount => Default_Indent_Amount,
- Chunk_Length => Default_Chunk_Length);
- The_Stderr : aliased File :=
- Create_From_FD (OS.Standerr,
- Indent_Amount => Default_Indent_Amount,
- Chunk_Length => Default_Chunk_Length);
-
- function Standard_Output return Sink_Access is (The_Stdout'Access);
- function Standard_Error return Sink_Access is (The_Stderr'Access);
-
-end Ada.Strings.Text_Output.Basic_Files;
diff --git a/gcc/ada/libgnat/a-stobfi.ads b/gcc/ada/libgnat/a-stobfi.ads
deleted file mode 100644
index 89fcb4d7d85..00000000000
--- a/gcc/ada/libgnat/a-stobfi.ads
+++ /dev/null
@@ -1,66 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.BASIC_FILES --
--- --
--- S p e c --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-private with GNAT.OS_Lib;
-package Ada.Strings.Text_Output.Basic_Files is
- -- Normally, you should use Ada.Strings.Text_Output.Files, which
- -- automatically Closes files via finalization. If you don't want to use
- -- finalization, use this package instead. You must then Close the file by
- -- hand. The semantics is otherwise the same as Files.
-
- function Standard_Output return Sink_Access;
- function Standard_Error return Sink_Access;
-
- type File (<>) is new Sink with private;
-
- function Create_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File;
- function Create_New_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File;
-
- procedure Close (S : in out File'Class);
-
-private
-
- package OS renames GNAT.OS_Lib;
-
- type File is new Sink with record
- FD : OS.File_Descriptor := OS.Invalid_FD;
- end record;
-
- overriding procedure Full_Method (S : in out File);
- overriding procedure Flush_Method (S : in out File);
-
-end Ada.Strings.Text_Output.Basic_Files;
diff --git a/gcc/ada/libgnat/a-stoubu.adb b/gcc/ada/libgnat/a-stoubu.adb
deleted file mode 100644
index 3c5433866a1..00000000000
--- a/gcc/ada/libgnat/a-stoubu.adb
+++ /dev/null
@@ -1,148 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.BUFFERS --
--- --
--- B o d y --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Unchecked_Deallocation;
-with Ada.Strings.UTF_Encoding.Strings;
-with Ada.Strings.UTF_Encoding.Wide_Strings;
-with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
-package body Ada.Strings.Text_Output.Buffers is
-
- type Chunk_Access is access all Chunk;
-
- function New_Buffer
- (Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return Buffer
- is
- begin
- return Result : Buffer (Chunk_Length) do
- Result.Indent_Amount := Indent_Amount;
- Result.Cur_Chunk := Result.Initial_Chunk'Unchecked_Access;
- end return;
- end New_Buffer;
-
- -- We need type conversions of Chunk_Access values in the following two
- -- procedures, because the one in Text_Output has Storage_Size => 0,
- -- because Text_Output is Pure. We do not run afoul of 13.11.2(16/3),
- -- which requires the allocation and deallocation to have the same pool,
- -- because the allocation in Full_Method and the deallocation in Destroy
- -- use the same access type, and therefore the same pool.
-
- procedure Destroy (S : in out Buffer) is
- procedure Free is new Unchecked_Deallocation (Chunk, Chunk_Access);
- Cur : Chunk_Access := Chunk_Access (S.Initial_Chunk.Next);
- begin
- while Cur /= null loop
- declare
- Temp : constant Chunk_Access := Chunk_Access (Cur.Next);
- begin
- Free (Cur);
- Cur := Temp;
- end;
- end loop;
-
- S.Cur_Chunk := null;
- end Destroy;
-
- overriding procedure Full_Method (S : in out Buffer) is
- begin
- pragma Assert (S.Cur_Chunk.Next = null);
- pragma Assert (S.Last = S.Cur_Chunk.Chars'Length);
- S.Cur_Chunk.Next :=
- Text_Output.Chunk_Access (Chunk_Access'(new Chunk (S.Chunk_Length)));
- S.Cur_Chunk := S.Cur_Chunk.Next;
- S.Num_Extra_Chunks := S.Num_Extra_Chunks + 1;
- S.Last := 0;
- end Full_Method;
-
- function UTF_8_Length (S : Buffer'Class) return Natural is
- begin
- return S.Num_Extra_Chunks * S.Chunk_Length + S.Last;
- end UTF_8_Length;
-
- procedure Get_UTF_8
- (S : Buffer'Class; Result : out UTF_8_Lines)
- is
- Cur : access constant Chunk := S.Initial_Chunk'Access;
- First : Positive := 1;
- begin
- loop
- if Cur.Next = null then
- pragma Assert (Result'Last = First + S.Last - 1);
- Result (First .. Result'Last) := Cur.Chars (1 .. S.Last);
- exit;
- end if;
-
- pragma Assert (S.Chunk_Length = Cur.Chars'Length);
- Result (First .. First + S.Chunk_Length - 1) := Cur.Chars;
- First := First + S.Chunk_Length;
- Cur := Cur.Next;
- end loop;
- end Get_UTF_8;
-
- function Get_UTF_8 (S : Buffer'Class) return UTF_8_Lines is
- begin
- return Result : String (1 .. UTF_8_Length (S)) do
- Get_UTF_8 (S, Result);
- end return;
- end Get_UTF_8;
-
- function Get (S : Buffer'Class) return String is
- begin
- -- If all characters are 7 bits, we don't need to decode;
- -- this is an optimization.
-
- -- Otherwise, if all are 8 bits, we need to decode to get Latin-1.
- -- Otherwise, the result is implementation defined, so we return a
- -- String encoded as UTF-8. (Note that the AI says "if any character
- -- in the sequence is not defined in Character, the result is
- -- implementation-defined", so we are not obliged to decode ANY
- -- Latin-1 characters if ANY character is bigger than 8 bits.
-
- if S.All_7_Bits then
- return Get_UTF_8 (S);
- elsif S.All_8_Bits then
- return UTF_Encoding.Strings.Decode (Get_UTF_8 (S));
- else
- return Get_UTF_8 (S);
- end if;
- end Get;
-
- function Wide_Get (S : Buffer'Class) return Wide_String is
- begin
- return UTF_Encoding.Wide_Strings.Decode (Get_UTF_8 (S));
- end Wide_Get;
-
- function Wide_Wide_Get (S : Buffer'Class) return Wide_Wide_String is
- begin
- return UTF_Encoding.Wide_Wide_Strings.Decode (Get_UTF_8 (S));
- end Wide_Wide_Get;
-
-end Ada.Strings.Text_Output.Buffers;
diff --git a/gcc/ada/libgnat/a-stoubu.ads b/gcc/ada/libgnat/a-stoubu.ads
deleted file mode 100644
index 0370cae1b41..00000000000
--- a/gcc/ada/libgnat/a-stoubu.ads
+++ /dev/null
@@ -1,73 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.BUFFERS --
--- --
--- S p e c --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-package Ada.Strings.Text_Output.Buffers is
-
- type Buffer (<>) is new Sink with private;
-
- function New_Buffer
- (Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return Buffer;
-
- procedure Destroy (S : in out Buffer);
- -- Reclaim any heap-allocated data, and render the Buffer unusable.
- -- It would make sense to do this via finalization, but we wish to
- -- avoid controlled types in the generated code for 'Image.
-
- function Get_UTF_8 (S : Buffer'Class) return UTF_8_Lines;
- -- Get the characters in S, encoded as UTF-8.
-
- function UTF_8_Length (S : Buffer'Class) return Natural;
- procedure Get_UTF_8
- (S : Buffer'Class; Result : out UTF_8_Lines) with
- Pre => Result'First = 1 and Result'Last = UTF_8_Length (S);
- -- This is a procedure version of the Get_UTF_8 function, for
- -- efficiency. The Result String must be the exact right length.
-
- function Get (S : Buffer'Class) return String;
- function Wide_Get (S : Buffer'Class) return Wide_String;
- function Wide_Wide_Get (S : Buffer'Class) return Wide_Wide_String;
- -- Get the characters in S, decoded as [[Wide_]Wide_]String.
- -- There is no need for procedure versions of these, because
- -- they are intended primarily to implement the [[Wide_]Wide_]Image
- -- attribute, which is already a function.
-
-private
- type Chunk_Count is new Natural;
- type Buffer is new Sink with record
- Num_Extra_Chunks : Natural := 0;
- -- Number of chunks in the linked list, not including Initial_Chunk.
- end record;
-
- overriding procedure Full_Method (S : in out Buffer);
- overriding procedure Flush_Method (S : in out Buffer) is null;
-
-end Ada.Strings.Text_Output.Buffers;
diff --git a/gcc/ada/libgnat/a-stoufi.adb b/gcc/ada/libgnat/a-stoufi.adb
deleted file mode 100644
index 3444e3b47d9..00000000000
--- a/gcc/ada/libgnat/a-stoufi.adb
+++ /dev/null
@@ -1,123 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.FILES --
--- --
--- B o d y --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Strings.Text_Output.Utils; use Ada.Strings.Text_Output.Utils;
-package body Ada.Strings.Text_Output.Files is
- use type OS.File_Descriptor;
-
- function Create_From_FD
- (FD : OS.File_Descriptor;
- Indent_Amount : Natural;
- Chunk_Length : Positive) return File;
- -- Create a file from an OS file descriptor
-
- function Create_From_FD
- (FD : OS.File_Descriptor;
- Indent_Amount : Natural;
- Chunk_Length : Positive) return File
- is
- begin
- if FD = OS.Invalid_FD then
- raise Program_Error;
- end if;
- return Result : File (Chunk_Length) do
- Result.Indent_Amount := Indent_Amount;
- Result.Cur_Chunk := Result.Initial_Chunk'Unchecked_Access;
- Result.FD := FD;
- end return;
- end Create_From_FD;
-
- function Create_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File
- is
- begin
- return Create_From_FD
- (OS.Create_File (Name, Fmode => OS.Binary),
- Indent_Amount, Chunk_Length);
- end Create_File;
-
- function Create_New_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File
- is
- begin
- return Create_From_FD
- (OS.Create_New_File (Name, Fmode => OS.Binary),
- Indent_Amount, Chunk_Length);
- end Create_New_File;
-
- overriding procedure Finalize (Ref : in out Self_Ref) is
- begin
- Close (Ref.Self.all);
- end Finalize;
-
- procedure Close (S : in out File'Class) is
- Status : Boolean;
- begin
- Flush (S);
-
- if S.FD not in OS.Standout | OS.Standerr then -- Don't close these
- OS.Close (S.FD, Status);
- if not Status then
- raise Program_Error;
- end if;
- end if;
- end Close;
-
- overriding procedure Full_Method (S : in out File) renames Flush_Method;
-
- overriding procedure Flush_Method (S : in out File) is
- pragma Assert (S.Cur_Chunk = S.Initial_Chunk'Unchecked_Access);
- Res : constant Integer :=
- OS.Write (S.FD, S.Cur_Chunk.Chars'Address, S.Last);
- begin
- if Res /= S.Last then
- raise Program_Error;
- end if;
- S.Last := 0;
- end Flush_Method;
-
- The_Stdout : aliased File :=
- Create_From_FD (OS.Standout,
- Indent_Amount => Default_Indent_Amount,
- Chunk_Length => Default_Chunk_Length);
- The_Stderr : aliased File :=
- Create_From_FD (OS.Standerr,
- Indent_Amount => Default_Indent_Amount,
- Chunk_Length => Default_Chunk_Length);
-
- function Standard_Output return Sink_Access is (The_Stdout'Access);
- function Standard_Error return Sink_Access is (The_Stderr'Access);
-
-end Ada.Strings.Text_Output.Files;
diff --git a/gcc/ada/libgnat/a-stoufi.ads b/gcc/ada/libgnat/a-stoufi.ads
deleted file mode 100644
index 330b84f201d..00000000000
--- a/gcc/ada/libgnat/a-stoufi.ads
+++ /dev/null
@@ -1,72 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.FILES --
--- --
--- S p e c --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-private with GNAT.OS_Lib;
-private with Ada.Finalization;
-package Ada.Strings.Text_Output.Files is
- -- This package supports a Sink type that sends output to a file. The file
- -- is automatically closed when finalized.
-
- function Standard_Output return Sink_Access;
- function Standard_Error return Sink_Access;
-
- type File (<>) is new Sink with private;
-
- function Create_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File;
- function Create_New_File
- (Name : String;
- Indent_Amount : Natural := Default_Indent_Amount;
- Chunk_Length : Positive := Default_Chunk_Length) return File;
- -- Create a file. Create_New_File raises an exception if the file already
- -- exists; Create_File overwrites.
-
- procedure Close (S : in out File'Class);
-
-private
-
- package OS renames GNAT.OS_Lib;
-
- type Self_Ref (Self : access File) is new Finalization.Limited_Controlled
- with null record;
- overriding procedure Finalize (Ref : in out Self_Ref);
-
- type File is new Sink with record
- FD : OS.File_Descriptor := OS.Invalid_FD;
- Ref : Self_Ref (File'Access);
- end record;
-
- overriding procedure Full_Method (S : in out File);
- overriding procedure Flush_Method (S : in out File);
-
-end Ada.Strings.Text_Output.Files;
diff --git a/gcc/ada/libgnat/a-stoufo.adb b/gcc/ada/libgnat/a-stoufo.adb
deleted file mode 100644
index 3be8826923c..00000000000
--- a/gcc/ada/libgnat/a-stoufo.adb
+++ /dev/null
@@ -1,155 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.FORMATTING --
--- --
--- B o d y --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Strings.Text_Output.Files;
-with Ada.Strings.Text_Output.Buffers; use Ada.Strings.Text_Output.Buffers;
-with Ada.Strings.Text_Output.Utils; use Ada.Strings.Text_Output.Utils;
-package body Ada.Strings.Text_Output.Formatting is
-
- procedure Put
- (S : in out Sink'Class; T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
- is
- J : Positive := T'First;
- Used : array (1 .. 9) of Boolean := (others => False);
- begin
- while J <= T'Last loop
- if T (J) = '\' then
- J := J + 1;
- case T (J) is
- when 'n' =>
- New_Line (S);
- when '\' =>
- Put_7bit (S, '\');
- when 'i' =>
- Indent (S);
- when 'o' =>
- Outdent (S);
- when 'I' =>
- Indent (S, 1);
- when 'O' =>
- Outdent (S, 1);
-
- when '1' =>
- Used (1) := True;
- Put_UTF_8_Lines (S, X1);
- when '2' =>
- Used (2) := True;
- Put_UTF_8_Lines (S, X2);
- when '3' =>
- Used (3) := True;
- Put_UTF_8_Lines (S, X3);
- when '4' =>
- Used (4) := True;
- Put_UTF_8_Lines (S, X4);
- when '5' =>
- Used (5) := True;
- Put_UTF_8_Lines (S, X5);
- when '6' =>
- Used (6) := True;
- Put_UTF_8_Lines (S, X6);
- when '7' =>
- Used (7) := True;
- Put_UTF_8_Lines (S, X7);
- when '8' =>
- Used (8) := True;
- Put_UTF_8_Lines (S, X8);
- when '9' =>
- Used (9) := True;
- Put_UTF_8_Lines (S, X9);
-
- when others =>
- raise Program_Error;
- end case;
- else
- Put_7bit (S, T (J));
- end if;
-
- J := J + 1;
- end loop;
-
- if not Used (1) then
- pragma Assert (X1 = "");
- end if;
- if not Used (2) then
- pragma Assert (X2 = "");
- end if;
- if not Used (3) then
- pragma Assert (X3 = "");
- end if;
- if not Used (4) then
- pragma Assert (X4 = "");
- end if;
- if not Used (5) then
- pragma Assert (X5 = "");
- end if;
- if not Used (6) then
- pragma Assert (X6 = "");
- end if;
- if not Used (7) then
- pragma Assert (X7 = "");
- end if;
- if not Used (8) then
- pragma Assert (X8 = "");
- end if;
- if not Used (9) then
- pragma Assert (X9 = "");
- end if;
-
- Flush (S);
- end Put;
-
- procedure Put
- (T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "") is
- begin
- Put (Files.Standard_Output.all, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
- end Put;
-
- procedure Err
- (T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "") is
- begin
- Put (Files.Standard_Error.all, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
- end Err;
-
- function Format
- (T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
- return UTF_8_Lines
- is
- Buf : Buffer := New_Buffer;
- begin
- Put (Buf, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
- return Get_UTF_8 (Buf);
- end Format;
-
-end Ada.Strings.Text_Output.Formatting;
diff --git a/gcc/ada/libgnat/a-stoufo.ads b/gcc/ada/libgnat/a-stoufo.ads
deleted file mode 100644
index a03d087603d..00000000000
--- a/gcc/ada/libgnat/a-stoufo.ads
+++ /dev/null
@@ -1,72 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.FORMATTING --
--- --
--- S p e c --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-package Ada.Strings.Text_Output.Formatting is
-
- -- Template-based output, based loosely on C's printf family. Unlike
- -- printf, it is type safe. We don't support myriad formatting options; the
- -- caller is expected to call 'Image, or other functions that might have
- -- various formatting capabilities.
- --
- -- Each of the following calls Flush
-
- type Template is new UTF_8;
- procedure Put
- (S : in out Sink'Class; T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
- -- Prints the template as is, except for the following escape sequences:
- -- "\n" is end of line.
- -- "\i" indents by the default amount, and "\o" outdents.
- -- "\I" indents by one space, and "\O" outdents.
- -- "\1" is replaced with X1, and similarly for 2, 3, ....
- -- "\\" is "\".
-
- -- Note that the template is not type String, to avoid this sort of thing:
- --
- -- https://xkcd.com/327/
-
- procedure Put
- (T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
- -- Sends to standard output
-
- procedure Err
- (T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "");
- -- Sends to standard error
-
- function Format
- (T : Template;
- X1, X2, X3, X4, X5, X6, X7, X8, X9 : UTF_8_Lines := "")
- return UTF_8_Lines;
- -- Returns a UTF-8-encoded String
-
-end Ada.Strings.Text_Output.Formatting;
diff --git a/gcc/ada/libgnat/a-stouut.adb b/gcc/ada/libgnat/a-stouut.adb
deleted file mode 100644
index 6b8f72ba84d..00000000000
--- a/gcc/ada/libgnat/a-stouut.adb
+++ /dev/null
@@ -1,272 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.UTILS --
--- --
--- B o d y --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
-
-package body Ada.Strings.Text_Output.Utils is
-
- procedure Put_Octet (S : in out Sink'Class; Item : Character) with Inline;
- -- Send a single octet to the current Chunk
-
- procedure Adjust_Column (S : in out Sink'Class) with Inline;
- -- Adjust the column for a non-NL character.
-
- procedure Put_UTF_8_Outline (S : in out Sink'Class; Item : UTF_8);
- -- Out-of-line portion of Put_UTF_8. This exists solely to make Put_UTF_8
- -- small enough to reasonably inline it.
-
- procedure Full (S : in out Sink'Class) is
- begin
- pragma Assert (S.Last = S.Chunk_Length);
- Full_Method (S);
- pragma Assert (S.Last = 0);
- end Full;
-
- procedure Flush (S : in out Sink'Class) is
- begin
- Flush_Method (S);
- end Flush;
-
- procedure Put_Octet (S : in out Sink'Class; Item : Character) is
- begin
- S.Last := S.Last + 1;
- S.Cur_Chunk.Chars (S.Last) := Item;
- pragma Assert (S.Chunk_Length = S.Cur_Chunk.Chars'Length);
- if S.Last = S.Chunk_Length then
- Full (S);
- end if;
- end Put_Octet;
-
- procedure Adjust_Column (S : in out Sink'Class) is
- begin
- -- If we're in the first column, indent. This is handled here, rather
- -- than when we see NL, because we don't want spaces in a blank line.
- -- The character we're about to put is not NL; NL is handled in
- -- New_Line. So after indenting, we simply increment the Column.
-
- if S.Column = 1 then
- Tab_To_Column (S, S.Indentation + 1);
- end if;
- S.Column := S.Column + 1;
- end Adjust_Column;
-
- procedure Put_7bit (S : in out Sink'Class; Item : Character_7) is
- begin
- Adjust_Column (S);
- Put_Octet (S, Item);
- end Put_7bit;
-
- procedure Put_7bit_NL (S : in out Sink'Class; Item : Character_7) is
- begin
- if Item = NL then
- New_Line (S);
- else
- Put_7bit (S, Item);
- end if;
- end Put_7bit_NL;
-
- procedure Put_Character (S : in out Sink'Class; Item : Character) is
- begin
- if Character'Pos (Item) < 2**7 then
- Put_7bit_NL (S, Item);
- else
- Put_Wide_Wide_Character (S, To_Wide_Wide (Item));
- end if;
- end Put_Character;
-
- procedure Put_Wide_Character
- (S : in out Sink'Class; Item : Wide_Character) is
- begin
- if Wide_Character'Pos (Item) < 2**7 then
- Put_7bit_NL (S, From_Wide (Item));
- else
- Put_Wide_Wide_Character (S, To_Wide_Wide (Item));
- end if;
- end Put_Wide_Character;
-
- procedure Put_Wide_Wide_Character
- (S : in out Sink'Class; Item : Wide_Wide_Character) is
- begin
- if Wide_Wide_Character'Pos (Item) < 2**7 then
- Put_7bit_NL (S, From_Wide_Wide (Item));
- else
- S.All_7_Bits := False;
- if Wide_Wide_Character'Pos (Item) >= 2**8 then
- S.All_8_Bits := False;
- end if;
- declare
- Temp : constant UTF_8_Lines :=
- UTF_Encoding.Wide_Wide_Strings.Encode ((1 => Item));
- begin
- for X of Temp loop
- pragma Assert (X /= NL);
- Adjust_Column (S);
- Put_Octet (S, X);
- end loop;
- end;
- end if;
- end Put_Wide_Wide_Character;
-
- procedure Put_UTF_8_Outline (S : in out Sink'Class; Item : UTF_8) is
- begin
- if S.Last + Item'Length = S.Chunk_Length then
- -- Item fits exactly in current chunk
-
- S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item;
- S.Last := S.Last + Item'Length;
- S.Column := S.Column + Item'Length;
- Full (S);
- -- ???Seems like maybe we shouldn't call Full until we have MORE
- -- characters. But then we can't pass Chunk_Length => 1 to
- -- Create_File to get unbuffered output.
- else
- -- We get here only if Item doesn't fit in the current chunk, which
- -- should be fairly rare. We split Item into Left and Right, where
- -- Left exactly fills the current chunk, and recurse on Left and
- -- Right. Right will fit into the next chunk unless it's very long,
- -- so another level of recursion will be extremely rare.
-
- declare
- Left_Length : constant Natural := S.Chunk_Length - S.Last;
- Right_First : constant Natural := Item'First + Left_Length;
- Left : UTF_8 renames Item (Item'First .. Right_First - 1);
- Right : UTF_8 renames Item (Right_First .. Item'Last);
- pragma Assert (Left & Right = Item);
- begin
- Put_UTF_8 (S, Left); -- This will call Full.
- Put_UTF_8 (S, Right); -- This might call Full, but probably not.
- end;
- end if;
- end Put_UTF_8_Outline;
-
- procedure Put_UTF_8 (S : in out Sink'Class; Item : UTF_8) is
- begin
- Adjust_Column (S);
-
- if S.Last + Item'Length < S.Chunk_Length then
- -- Item fits in current chunk
-
- S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item;
- S.Last := S.Last + Item'Length;
- S.Column := S.Column + Item'Length;
- else
- Put_UTF_8_Outline (S, Item);
- end if;
- end Put_UTF_8;
-
- procedure Put_UTF_8_Lines (S : in out Sink'Class; Item : UTF_8_Lines) is
- Line_Start, Index : Integer := Item'First;
- -- Needs to be Integer, because Item'First might be negative for empty
- -- Items.
- begin
- while Index <= Item'Last loop
- if Item (Index) = NL then
- if Index > Line_Start then
- Put_UTF_8 (S, Item (Line_Start .. Index - 1));
- end if;
- New_Line (S);
- Line_Start := Index + 1;
- end if;
-
- Index := Index + 1;
- end loop;
-
- if Index > Line_Start then
- Put_UTF_8 (S, Item (Line_Start .. Index - 1));
- end if;
- end Put_UTF_8_Lines;
-
- procedure Put_String (S : in out Sink'Class; Item : String) is
- begin
- for X of Item loop
- Put_Character (S, X);
- end loop;
- end Put_String;
-
- procedure Put_Wide_String (S : in out Sink'Class; Item : Wide_String) is
- begin
- for X of Item loop
- Put_Wide_Character (S, X);
- end loop;
- end Put_Wide_String;
-
- procedure Put_Wide_Wide_String
- (S : in out Sink'Class; Item : Wide_Wide_String) is
- begin
- for X of Item loop
- Put_Wide_Wide_Character (S, X);
- end loop;
- end Put_Wide_Wide_String;
-
- procedure New_Line (S : in out Sink'Class) is
- begin
- S.Column := 1;
- Put_Octet (S, NL);
- end New_Line;
-
- function Column (S : Sink'Class) return Positive is (S.Column);
-
- procedure Tab_To_Column (S : in out Sink'Class; Column : Positive) is
- begin
- if S.Column < Column then
- for X in 1 .. Column - S.Column loop
- Put_Octet (S, ' ');
- end loop;
- S.Column := Column;
- end if;
- end Tab_To_Column;
-
- procedure Set_Indentation (S : in out Sink'Class; Amount : Natural) is
- begin
- S.Indentation := Amount;
- end Set_Indentation;
-
- function Indentation (S : Sink'Class) return Natural is (S.Indentation);
-
- procedure Indent
- (S : in out Sink'Class; Amount : Optional_Indentation := Default)
- is
- By : constant Natural :=
- (if Amount = Default then S.Indent_Amount else Amount);
- begin
- Set_Indentation (S, Indentation (S) + By);
- end Indent;
-
- procedure Outdent
- (S : in out Sink'Class; Amount : Optional_Indentation := Default)
- is
- By : constant Natural :=
- (if Amount = Default then S.Indent_Amount else Amount);
- begin
- Set_Indentation (S, Indentation (S) - By);
- end Outdent;
-
-end Ada.Strings.Text_Output.Utils;
diff --git a/gcc/ada/libgnat/a-stouut.ads b/gcc/ada/libgnat/a-stouut.ads
deleted file mode 100644
index 69cde5573e6..00000000000
--- a/gcc/ada/libgnat/a-stouut.ads
+++ /dev/null
@@ -1,107 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT.UTILS --
--- --
--- S p e c --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-package Ada.Strings.Text_Output.Utils with Pure is
-
- -- This package provides utility functions on Sink'Class. These are
- -- intended for use by Put_Image attributes, both the default versions
- -- generated by the compiler, and user-defined ones.
-
- procedure Full (S : in out Sink'Class) with Inline;
- -- Must be called when the current chunk is full. Dispatches to
- -- Full_Method.
-
- procedure Flush (S : in out Sink'Class) with Inline;
- -- Dispatches to Flush_Method
-
- -- Full_Method and Flush_Method should be called only via Full and Flush
-
- procedure Put_Character (S : in out Sink'Class; Item : Character);
- procedure Put_Wide_Character (S : in out Sink'Class; Item : Wide_Character);
- procedure Put_Wide_Wide_Character
- (S : in out Sink'Class; Item : Wide_Wide_Character);
- procedure Put_String (S : in out Sink'Class; Item : String);
- procedure Put_Wide_String (S : in out Sink'Class; Item : Wide_String);
- procedure Put_Wide_Wide_String
- (S : in out Sink'Class; Item : Wide_Wide_String);
- -- Encode characters or strings as UTF-8, and send them to S.
-
- subtype Character_7 is
- Character range Character'Val (0) .. Character'Val (2**7 - 1);
- -- 7-bit character. These are the same in both Latin-1 and UTF-8.
-
- procedure Put_7bit (S : in out Sink'Class; Item : Character_7)
- with Inline, Pre => Item /= NL;
- procedure Put_7bit_NL (S : in out Sink'Class; Item : Character_7)
- with Inline;
- -- Put a 7-bit character, and adjust the Column. For Put_7bit_NL, Item can
- -- be NL.
-
- procedure Put_UTF_8 (S : in out Sink'Class; Item : UTF_8) with Inline;
- procedure Put_UTF_8_Lines (S : in out Sink'Class; Item : UTF_8_Lines);
- -- Send data that is already UTF-8 encoded (including 7-bit ASCII) to
- -- S. These are more efficient than Put_String.
-
- procedure New_Line (S : in out Sink'Class) with
- Inline, Post => Column (S) = 1;
- -- Puts the new-line character.
-
- function Column (S : Sink'Class) return Positive with Inline;
- -- Current output column. The Column is initially 1, and is incremented for
- -- each 7-bit character output, except for the new-line character, which
- -- sets Column back to 1. The next character to be output will go in this
- -- column.
-
- procedure Tab_To_Column (S : in out Sink'Class; Column : Positive);
- -- Put spaces until we're at or past Column.
-
- procedure Set_Indentation (S : in out Sink'Class; Amount : Natural)
- with Inline;
- function Indentation (S : Sink'Class) return Natural with Inline;
- -- Indentation is initially 0. Set_Indentation sets it, and Indentation
- -- returns it. This number of space characters are put at the start of
- -- each nonempty line.
-
- subtype Optional_Indentation is Integer range -1 .. Natural'Last;
- Default : constant Optional_Indentation := -1;
-
- procedure Indent
- (S : in out Sink'Class; Amount : Optional_Indentation := Default)
- with Inline;
- procedure Outdent
- (S : in out Sink'Class; Amount : Optional_Indentation := Default)
- with Inline;
- -- Increase/decrease Indentation by Amount. If Amount = Default, the amount
- -- specified by the Indent_Amount parameter of the sink creation function
- -- is used. The sink creation functions are New_Buffer, Create_File, and
- -- Create_New_File.
-
-end Ada.Strings.Text_Output.Utils;
diff --git a/gcc/ada/libgnat/a-stteou.ads b/gcc/ada/libgnat/a-stteou.ads
deleted file mode 100644
index 324c9e6f947..00000000000
--- a/gcc/ada/libgnat/a-stteou.ads
+++ /dev/null
@@ -1,193 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- ADA.STRINGS.TEXT_OUTPUT --
--- --
--- S p e c --
--- --
--- Copyright (C) 2020-2021, 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- --
--- ware Foundation; either version 3, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. --
--- --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception, --
--- version 3.1, as published by the Free Software Foundation. --
--- --
--- You should have received a copy of the GNU General Public License and --
--- a copy of the GCC Runtime Library Exception along with this program; --
--- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--- <http://www.gnu.org/licenses/>. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Strings.UTF_Encoding;
-with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
-
-package Ada.Strings.Text_Output with Pure is
-
- -- This package provides a "Sink" abstraction, to which characters of type
- -- Character, Wide_Character, and Wide_Wide_Character can be sent. This
- -- type is used by the Put_Image attribute. In particular, T'Put_Image has
- -- the following parameter types:
- --
- -- procedure T'Put_Image (S : in out Sink'Class; V : T);
- --
- -- The default generated code for Put_Image of a composite type will
- -- typically call Put_Image on the components.
- --
- -- This is not a fully general abstraction that can be arbitrarily
- -- extended. It is designed with particular extensions in mind, and these
- -- extensions are declared in child packages of this package, because they
- -- depend on implementation details in the private part of this
- -- package.
- --
- -- Users are not expected to extend type Sink.
- --
- -- The primary extensions of Sink are:
- --
- -- Buffer. The characters sent to a Buffer are stored in memory, and can
- -- be retrieved via Get functions. This is intended for the
- -- implementation of the 'Image attribute. The compiler will generate a
- -- T'Image function that declares a local Buffer, sends characters to
- -- it, and then returns a call to Get, Destroying the Buffer on return.
- --
- -- function T'Image (V : T) return String is
- -- Buf : Buffer := New_Buffer (...);
- -- begin
- -- T'Put_Image (Buf, V);
- -- return Result : constant String := Get (Buf) do
- -- Destroy (Buf);
- -- end return;
- -- end T'Image;
- -- ????Perhaps Buffer should be controlled; if you don't like
- -- controlled types, call Put_Image directly.
- --
- -- File. The characters are sent to a file, possibly opened by file
- -- name, or possibly standard output or standard error. 'Put_Image
- -- can be called directly on a File, thus avoiding any heap allocation.
-
- type Sink (<>) is abstract tagged limited private;
- type Sink_Access is access all Sink'Class with Storage_Size => 0;
- -- Sink is a character sink; you can send characters to a Sink.
- -- UTF-8 encoding is used.
-
- procedure Full_Method (S : in out Sink) is abstract;
- procedure Flush_Method (S : in out Sink) is abstract;
- -- There is an internal buffer to store the characters. Full_Method is
- -- called when the buffer is full, and Flush_Method may be called to flush
- -- the buffer. For Buffer, Full_Method allocates more space for more
- -- characters, and Flush_Method does nothing. For File, Full_Method and
- -- Flush_Method do the same thing: write the characters to the file, and
- -- empty the internal buffer.
- --
- -- These are the only dispatching subprograms on Sink. This is for
- -- efficiency; we don't dispatch on every write to the Sink, but only when
- -- the internal buffer is full (or upon client request).
- --
- -- Full_Method and Flush_Method must make the current chunk empty.
- --
- -- Additional operations operating on Sink'Class are declared in the Utils
- -- child, including Full and Flush, which call the above.
-
- function To_Wide (C : Character) return Wide_Character is
- (Wide_Character'Val (Character'Pos (C)));
- function To_Wide_Wide (C : Character) return Wide_Wide_Character is
- (Wide_Wide_Character'Val (Character'Pos (C)));
- function To_Wide_Wide (C : Wide_Character) return Wide_Wide_Character is
- (Wide_Wide_Character'Val (Wide_Character'Pos (C)));
- -- Conversions [Wide_]Character --> [Wide_]Wide_Character.
- -- These cannot fail.
-
- function From_Wide (C : Wide_Character) return Character is
- (Character'Val (Wide_Character'Pos (C)));
- function From_Wide_Wide (C : Wide_Wide_Character) return Character is
- (Character'Val (Wide_Wide_Character'Pos (C)));
- function From_Wide_Wide (C : Wide_Wide_Character) return Wide_Character is
- (Wide_Character'Val (Wide_Wide_Character'Pos (C)));
- -- Conversions [Wide_]Wide_Character --> [Wide_]Character.
- -- These fail if the character is out of range.
-
- function NL return Character is (ASCII.LF) with Inline;
- function Wide_NL return Wide_Character is (To_Wide (Character'(NL)))
- with Inline;
- function Wide_Wide_NL return Wide_Wide_Character is
- (To_Wide_Wide (Character'(NL))) with Inline;
- -- Character representing new line. There is no support for CR/LF line
- -- endings.
-
- -- We have two subtypes of String that are encoded in UTF-8. UTF_8 cannot
- -- contain newline characters; UTF_8_Lines can. Sending UTF_8 data to a
- -- Sink is more efficient, because end-of-line processing is not needed.
- -- Both of these are more efficient than [[Wide_]Wide_]String, because no
- -- encoding is needed.
-
- subtype UTF_8_Lines is UTF_Encoding.UTF_8_String with
- Predicate =>
- UTF_Encoding.Wide_Wide_Strings.Encode
- (UTF_Encoding.Wide_Wide_Strings.Decode (UTF_8_Lines)) = UTF_8_Lines;
-
- subtype UTF_8 is UTF_8_Lines with
- Predicate => (for all UTF_8_Char of UTF_8 => UTF_8_Char /= NL);
-
- Default_Indent_Amount : constant Natural := 4;
-
- Default_Chunk_Length : constant Positive := 500;
- -- Experiment shows this value to be reasonably efficient; decreasing it
- -- slows things down, but increasing it doesn't gain much.
-
-private
- -- For Buffer, the "internal buffer" mentioned above is implemented as a
- -- linked list of chunks. When the current chunk is full, we allocate a new
- -- one. For File, there is only one chunk. When it is full, we send the
- -- data to the file, and empty it.
-
- type Chunk;
- type Chunk_Access is access all Chunk with Storage_Size => 0;
- type Chunk (Length : Positive) is limited record
- Next : Chunk_Access := null;
- Chars : UTF_8_Lines (1 .. Length);
- end record;
-
- type Sink (Chunk_Length : Positive) is abstract tagged limited record
- Indent_Amount : Natural;
- Column : Positive := 1;
- Indentation : Natural := 0;
-
- All_7_Bits : Boolean := True;
- -- For optimization of Text_Output.Buffers.Get (cf).
- -- True if all characters seen so far fit in 7 bits.
- -- 7-bit characters are represented the same in Character
- -- and in UTF-8, so they don't need translation.
-
- All_8_Bits : Boolean := True;
- -- True if all characters seen so far fit in 8 bits.
- -- This is needed in Text_Output.Buffers.Get to distinguish
- -- the case where all characters are Latin-1 (so it should
- -- decode) from the case where some characters are bigger than
- -- 8 bits (so the result is implementation defined).
-
- Cur_Chunk : Chunk_Access;
- -- Points to the chunk we are currently sending characters to.
- -- We want to say:
- -- Cur_Chunk : Chunk_Access := Initial_Chunk'Access;
- -- but that's illegal, so we have some horsing around to do.
-
- Last : Natural := 0;
- -- Last-used character in Cur_Chunk.all.
-
- Initial_Chunk : aliased Chunk (Length => Chunk_Length);
- -- For Buffer, this is the first chunk. Subsequent chunks are allocated
- -- on the heap. For File, this is the only chunk, and there is no heap
- -- allocation.
- end record;
-
-end Ada.Strings.Text_Output;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-07-05 13:15 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-07-05 13:15 [gcc r12-2027] [Ada] Remove Ada.Strings.Text_Output and child units Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).