public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-1692] [Ada] Add Ada.Strings.Text_Buffers and replace uses of Ada.Strings.Text_Output
@ 2021-06-21 11:06 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-06-21 11:06 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:20922782976048592eb9240ad2ab8690b207dc24
commit r12-1692-g20922782976048592eb9240ad2ab8690b207dc24
Author: Steve Baird <baird@adacore.com>
Date: Mon Mar 29 17:09:31 2021 -0700
[Ada] Add Ada.Strings.Text_Buffers and replace uses of Ada.Strings.Text_Output
gcc/ada/
* Make-generated.in (GEN_IL_FLAGS): Keep only GNAT flags.
(ada/stamp-gen_il): Remove dependencies on libgnat/ sources. Do not
copy libgnat/ sources locally and tidy up.
* Makefile.rtl: Include object files for new Text_Buffer units
in the GNATRTL_NONTASKING_OBJS list.
* exp_put_image.ads, exp_put_image.adb: Update Rtsfind calls to
match new specs. For example, calls to RE_Sink are replaced with
calls to RE_Root_Buffer_Type. Update comments and change
subprogram names accordingly (e.g., Preload_Sink is changed to
Preload_Root_Buffer_Type).
* impunit.adb: Add 6 new predefined units (Text_Buffers and 5
child units thereof).
* rtsfind.ads, rtsfind.adb: Add interfaces for accessing the
Ada.Strings.Text_Buffers package and declarations
therein (including the Unbounded child unit). Do not (yet)
delete interfaces for accessing the old Text_Output package.
* sem_attr.adb (Check_Put_Image_Attribute): Replace RE_Sink uses
with RE_Root_Buffer_Type and update comments accordingly.
* sem_ch10.adb (Analyze_Compilation_Unit): Update call to
reflect name change of callee (that is, the former Preload_Sink
is now Preload_Root_Buffer_Type).
* sem_ch13.adb (Has_Good_Profile): Replace RE_Sink use with
RE_Root_Buffer_Type.
(Build_Spec): Update comment describing a parameter type.
* gen_il.ads: Remove clauses for the old Text_Output package and
add them for Ada.Streams.Stream_IO.
(Sink): Declare.
(Create_File): Likewise.
(Increase_Indent): Likewise.
(Decrease_Indent): Likewise.
(Put): Likewise.
(LF): Likewise.
* gen_il.adb: Add clauses for Ada.Streams.Stream_IO.
(Create_File): New procedure.
(Increase_Indent): Likewise.
(Decrease_Indent): Likewise.
(Put): New procedures.
* gen_il-gen.adb: Add clauses for Ada.Text_IO. Replace
Sink'Class with Sink throughout. Use string concatenation and
LF marker instead of formatted strings and "\n" marker. Update
Indent/Outdent calls to use new Increase_Indent/Decrease_Indent
names.
(Put_Membership_Query_Decl): Remove.
* gen_il-internals.ads: Replace Sink'Class with Sink throughout.
(Ptypes): Remove.
(Pfields): Likewise.
* gen_il-internals.adb: Remove clauses for GNAT.OS_Lib and
Ada.Strings.Text_Buffers.Files. Replace Sink'Class with Sink
throughout. Use string concatenation and LF marker instead of
formatted strings and "\n" marker.
(Stdout): Remove.
(Ptypes): Likewise.
(Pfields): Likewise.
* libgnarl/s-putaim.ads: Modify context clause, update
declaration of subtype Sink to refer to
Text_Buffers.Root_Buffer_Type instead of the old
Text_Output.Sink type.
* libgnarl/s-putaim.adb: Modify context clause and add use
clause to refer to Text_Buffers package.
* libgnat/a-cbdlli.ads, libgnat/a-cbdlli.adb,
libgnat/a-cbhama.ads, libgnat/a-cbhama.adb,
libgnat/a-cbhase.ads, libgnat/a-cbhase.adb,
libgnat/a-cbmutr.ads, libgnat/a-cbmutr.adb,
libgnat/a-cborma.ads, libgnat/a-cborma.adb,
libgnat/a-cborse.ads, libgnat/a-cborse.adb,
libgnat/a-cdlili.ads, libgnat/a-cdlili.adb,
libgnat/a-cidlli.ads, libgnat/a-cidlli.adb,
libgnat/a-cihama.ads, libgnat/a-cihama.adb,
libgnat/a-cihase.ads, libgnat/a-cihase.adb,
libgnat/a-cimutr.ads, libgnat/a-cimutr.adb,
libgnat/a-ciorma.ads, libgnat/a-ciorma.adb,
libgnat/a-ciormu.ads, libgnat/a-ciormu.adb,
libgnat/a-ciorse.ads, libgnat/a-ciorse.adb,
libgnat/a-coboho.ads, libgnat/a-coboho.adb,
libgnat/a-cobove.ads, libgnat/a-cobove.adb,
libgnat/a-cohama.ads, libgnat/a-cohama.adb,
libgnat/a-cohase.ads, libgnat/a-cohase.adb,
libgnat/a-coinho.ads, libgnat/a-coinho.adb,
libgnat/a-coinho__shared.ads, libgnat/a-coinho__shared.adb,
libgnat/a-coinve.ads, libgnat/a-coinve.adb,
libgnat/a-comutr.ads, libgnat/a-comutr.adb,
libgnat/a-convec.ads, libgnat/a-convec.adb,
libgnat/a-coorma.ads, libgnat/a-coorma.adb,
libgnat/a-coormu.ads, libgnat/a-coormu.adb,
libgnat/a-coorse.ads, libgnat/a-coorse.adb,
libgnat/a-nbnbin.ads, libgnat/a-nbnbin.adb,
libgnat/a-nbnbin__gmp.adb, libgnat/a-nbnbre.ads,
libgnat/a-nbnbre.adb, libgnat/a-strunb.ads,
libgnat/a-strunb.adb, libgnat/a-strunb__shared.ads,
libgnat/a-strunb__shared.adb, libgnat/s-rannum.ads,
libgnat/s-rannum.adb: Modify Put_Image procedure used in
Put_Image aspect specification to conform to Ada profile
rules (in particular, the first parameter shall be of type
Ada.Strings.Text_Buffers.Root_Buffer_Type'Class).
* libgnat/a-sttebu.ads, libgnat/a-sttebu.adb,
libgnat/a-stbubo.ads, libgnat/a-stbubo.adb,
libgnat/a-stbufi.ads, libgnat/a-stbufi.adb,
libgnat/a-stbufo.ads, libgnat/a-stbufo.adb,
libgnat/a-stbuun.ads, libgnat/a-stbuun.adb,
libgnat/a-stbuut.ads, libgnat/a-stbuut.adb: A new predefined
unit, Ada.Strings.Text_Buffers, and five child units. Two of
the five are RM-defined: Bounded and Unbounded. The remaining
three are GNAT-defined: Files, Utils, and Formatting. The buffer
type corresponding to an output file, type Files.File_Buffer, is
simpler (and perhaps therefore slower) than its predecessor.
Caching similar to what was being done before could be added
later if that seems appropriate.
* libgnat/s-putima.ads: Modify context clause, update
declaration of subtype Sink to refer to
Text_Buffers.Root_Buffer_Type instead of the old
Text_Output.Sink type.
* libgnat/s-putima.adb: Modify context clause. Update
Indent/Outdent calls to use new Increase_Indent/Decrease_Indent
names; ditto for "Put_String => Put" name change.
* libgnat/a-stteou__bootstrap.ads: Delete.
Diff:
---
gcc/ada/Make-generated.in | 13 +-
gcc/ada/Makefile.rtl | 6 +
gcc/ada/exp_put_image.adb | 59 +-
gcc/ada/exp_put_image.ads | 13 +-
gcc/ada/gen_il-gen.adb | 1123 +++++++++++++++----------------
gcc/ada/gen_il-internals.adb | 57 +-
gcc/ada/gen_il-internals.ads | 9 +-
gcc/ada/gen_il.adb | 73 ++
gcc/ada/gen_il.ads | 27 +-
gcc/ada/impunit.adb | 14 +-
gcc/ada/libgnarl/s-putaim.adb | 7 +-
gcc/ada/libgnarl/s-putaim.ads | 4 +-
gcc/ada/libgnat/a-cbdlli.adb | 2 +-
gcc/ada/libgnat/a-cbdlli.ads | 4 +-
gcc/ada/libgnat/a-cbhama.adb | 2 +-
gcc/ada/libgnat/a-cbhama.ads | 4 +-
gcc/ada/libgnat/a-cbhase.adb | 2 +-
gcc/ada/libgnat/a-cbhase.ads | 4 +-
gcc/ada/libgnat/a-cbmutr.adb | 2 +-
gcc/ada/libgnat/a-cbmutr.ads | 4 +-
gcc/ada/libgnat/a-cborma.adb | 2 +-
gcc/ada/libgnat/a-cborma.ads | 4 +-
gcc/ada/libgnat/a-cborse.adb | 2 +-
gcc/ada/libgnat/a-cborse.ads | 4 +-
gcc/ada/libgnat/a-cdlili.adb | 2 +-
gcc/ada/libgnat/a-cdlili.ads | 4 +-
gcc/ada/libgnat/a-cidlli.adb | 2 +-
gcc/ada/libgnat/a-cidlli.ads | 4 +-
gcc/ada/libgnat/a-cihama.adb | 2 +-
gcc/ada/libgnat/a-cihama.ads | 4 +-
gcc/ada/libgnat/a-cihase.adb | 2 +-
gcc/ada/libgnat/a-cihase.ads | 4 +-
gcc/ada/libgnat/a-cimutr.adb | 2 +-
gcc/ada/libgnat/a-cimutr.ads | 4 +-
gcc/ada/libgnat/a-ciorma.adb | 2 +-
gcc/ada/libgnat/a-ciorma.ads | 4 +-
gcc/ada/libgnat/a-ciormu.adb | 2 +-
gcc/ada/libgnat/a-ciormu.ads | 4 +-
gcc/ada/libgnat/a-ciorse.adb | 2 +-
gcc/ada/libgnat/a-ciorse.ads | 4 +-
gcc/ada/libgnat/a-coboho.adb | 2 +-
gcc/ada/libgnat/a-coboho.ads | 4 +-
gcc/ada/libgnat/a-cobove.adb | 2 +-
gcc/ada/libgnat/a-cobove.ads | 4 +-
gcc/ada/libgnat/a-cohama.adb | 2 +-
gcc/ada/libgnat/a-cohama.ads | 4 +-
gcc/ada/libgnat/a-cohase.adb | 2 +-
gcc/ada/libgnat/a-cohase.ads | 4 +-
gcc/ada/libgnat/a-coinho.adb | 2 +-
gcc/ada/libgnat/a-coinho.ads | 4 +-
gcc/ada/libgnat/a-coinho__shared.adb | 2 +-
gcc/ada/libgnat/a-coinho__shared.ads | 4 +-
gcc/ada/libgnat/a-coinve.adb | 2 +-
gcc/ada/libgnat/a-coinve.ads | 4 +-
gcc/ada/libgnat/a-comutr.adb | 2 +-
gcc/ada/libgnat/a-comutr.ads | 4 +-
gcc/ada/libgnat/a-convec.adb | 2 +-
gcc/ada/libgnat/a-convec.ads | 4 +-
gcc/ada/libgnat/a-coorma.adb | 2 +-
gcc/ada/libgnat/a-coorma.ads | 4 +-
gcc/ada/libgnat/a-coormu.adb | 2 +-
gcc/ada/libgnat/a-coormu.ads | 4 +-
gcc/ada/libgnat/a-coorse.adb | 2 +-
gcc/ada/libgnat/a-coorse.ads | 4 +-
gcc/ada/libgnat/a-nbnbin.adb | 5 +-
gcc/ada/libgnat/a-nbnbin.ads | 4 +-
gcc/ada/libgnat/a-nbnbin__gmp.adb | 5 +-
gcc/ada/libgnat/a-nbnbre.adb | 5 +-
gcc/ada/libgnat/a-nbnbre.ads | 4 +-
gcc/ada/libgnat/a-stbubo.adb | 147 ++++
gcc/ada/libgnat/a-stbubo.ads | 73 ++
gcc/ada/libgnat/a-stbufi.adb | 82 +++
gcc/ada/libgnat/a-stbufi.ads | 75 +++
gcc/ada/libgnat/a-stbufo.adb | 158 +++++
gcc/ada/libgnat/a-stbufo.ads | 73 ++
gcc/ada/libgnat/a-stbuun.adb | 193 ++++++
gcc/ada/libgnat/a-stbuun.ads | 87 +++
gcc/ada/libgnat/a-stbuut.adb | 81 +++
gcc/ada/libgnat/a-stbuut.ads | 82 +++
gcc/ada/libgnat/a-strunb.adb | 3 +-
gcc/ada/libgnat/a-strunb.ads | 5 +-
gcc/ada/libgnat/a-strunb__shared.adb | 3 +-
gcc/ada/libgnat/a-strunb__shared.ads | 5 +-
gcc/ada/libgnat/a-sttebu.adb | 121 ++++
gcc/ada/libgnat/a-sttebu.ads | 135 ++++
gcc/ada/libgnat/a-stteou__bootstrap.ads | 190 ------
gcc/ada/libgnat/s-putima.adb | 16 +-
gcc/ada/libgnat/s-putima.ads | 4 +-
gcc/ada/libgnat/s-rannum.adb | 5 +-
gcc/ada/libgnat/s-rannum.ads | 4 +-
gcc/ada/rtsfind.adb | 11 +-
gcc/ada/rtsfind.ads | 37 +-
gcc/ada/sem_attr.adb | 9 +-
gcc/ada/sem_ch10.adb | 2 +-
gcc/ada/sem_ch13.adb | 6 +-
95 files changed, 2180 insertions(+), 1011 deletions(-)
diff --git a/gcc/ada/Make-generated.in b/gcc/ada/Make-generated.in
index 2308b01933b..129909b4020 100644
--- a/gcc/ada/Make-generated.in
+++ b/gcc/ada/Make-generated.in
@@ -13,19 +13,12 @@ endif
fsrcdir := $(shell cd $(srcdir);${PWD_COMMAND})
GEN_IL_INCLUDES = -I$(fsrcdir)/ada
-GEN_IL_FLAGS = -a -q -g -gnata -j0 -gnat2012 -gnatw.g -gnatyg -gnatU $(GEN_IL_INCLUDES)
+GEN_IL_FLAGS = -gnata -gnat2012 -gnatw.g -gnatyg -gnatU $(GEN_IL_INCLUDES)
ada/seinfo_tables.ads ada/seinfo_tables.adb ada/sinfo.h ada/einfo.h ada/nmake.ads ada/nmake.adb ada/seinfo.ads ada/sinfo-nodes.ads ada/sinfo-nodes.adb ada/einfo-entities.ads ada/einfo-entities.adb: ada/stamp-gen_il ; @true
-ada/stamp-gen_il: $(fsrcdir)/ada/gen_il* $(fsrcdir)/ada/libgnat/a-sto*.ad? $(fsrcdir)/ada/libgnat/a-stteou__bootstrap.ads
+ada/stamp-gen_il: $(fsrcdir)/ada/gen_il*
$(MKDIR) ada/gen_il
- # Copy recent runtime files needed by gen_il that may not be available
- # in the base compiler.
- $(CP) -f $(fsrcdir)/ada/libgnat/a-sto*.ad? ada/gen_il
- $(CP) -f $(fsrcdir)/ada/libgnat/a-stteou__bootstrap.ads ada/gen_il/a-stteou.ads
- cd ada/gen_il ; gnatmake $(GEN_IL_FLAGS) gen_il-main.adb
- # ignore errors when running gen_il-main due to bootstrap
- # considerations
- -cd ada/gen_il ; ./gen_il-main
+ cd ada/gen_il ; gnatmake -q -g $(GEN_IL_FLAGS) gen_il-main ; ./gen_il-main
$(fsrcdir)/../move-if-change ada/gen_il/seinfo_tables.ads ada/seinfo_tables.ads
$(fsrcdir)/../move-if-change ada/gen_il/seinfo_tables.adb ada/seinfo_tables.adb
$(fsrcdir)/../move-if-change ada/gen_il/sinfo.h ada/sinfo.h
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 6ab07c8b534..f626c5d26a1 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -296,6 +296,12 @@ GNATRTL_NONTASKING_OBJS= \
a-strunb$(objext) \
a-ststio$(objext) \
a-stteou$(objext) \
+ a-sttebu$(objext) \
+ a-stbuun$(objext) \
+ a-stbubo$(objext) \
+ a-stbuut$(objext) \
+ a-stbufi$(objext) \
+ a-stbufo$(objext) \
a-stunau$(objext) \
a-stunha$(objext) \
a-stuten$(objext) \
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index a41b71f1795..33c72c3fad0 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -339,7 +339,7 @@ package body Exp_Put_Image is
-- For other elementary types, generate:
--
- -- Put_Wide_Wide_String (Sink, U_Type'Wide_Wide_Image (Item));
+ -- Wide_Wide_Put (Sink, U_Type'Wide_Wide_Image (Item));
--
-- It would be more elegant to do it the other way around (define
-- '[[Wide_]Wide_]Image in terms of 'Put_Image). But this is easier
@@ -366,7 +366,7 @@ package body Exp_Put_Image is
Put_Call : constant Node_Id :=
Make_Procedure_Call_Statement (Loc,
Name =>
- New_Occurrence_Of (RTE (RE_Put_Wide_Wide_String), Loc),
+ New_Occurrence_Of (RTE (RE_Wide_Wide_Put), Loc),
Parameter_Associations => New_List
(Relocate_Node (Sink), Image));
begin
@@ -758,7 +758,8 @@ package body Exp_Put_Image is
In_Present => True,
Out_Present => True,
Parameter_Type =>
- New_Occurrence_Of (Class_Wide_Type (RTE (RE_Sink)), Loc)),
+ New_Occurrence_Of
+ (Class_Wide_Type (RTE (RE_Root_Buffer_Type)), Loc)),
Make_Parameter_Specification (Loc,
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
@@ -816,13 +817,16 @@ package body Exp_Put_Image is
function Enable_Put_Image (Typ : Entity_Id) return Boolean is
begin
+ -- The name "Sink" here is a short nickname for
+ -- "Ada.Strings.Text_Buffers.Root_Buffer_Type".
+
-- There's a bit of a chicken&egg problem. The compiler is likely to
-- have trouble if we refer to the Put_Image of Sink itself, because
-- Sink is part of the parameter profile:
--
-- function Sink'Put_Image (S : in out Sink'Class; V : T);
--
- -- Likewise, the Ada.Strings.Text_Output package, where Sink is
+ -- Likewise, the Ada.Strings.Buffer package, where Sink is
-- declared, depends on various other packages, so if we refer to
-- Put_Image of types declared in those other packages, we could create
-- cyclic dependencies. Therefore, we disable Put_Image for some
@@ -858,13 +862,13 @@ package body Exp_Put_Image is
-- If type Sink is unavailable in this runtime, disable Put_Image
-- altogether.
- if No_Run_Time_Mode or else not RTE_Available (RE_Sink) then
+ if No_Run_Time_Mode or else not RTE_Available (RE_Root_Buffer_Type) then
return False;
end if;
- -- ???Disable Put_Image on type Sink declared in
- -- Ada.Strings.Text_Output. Note that we can't call Is_RTU on
- -- Ada_Strings_Text_Output, because it's not known yet (we might be
+ -- ???Disable Put_Image on type Root_Buffer_Type declared in
+ -- Ada.Strings.Text_Buffers. Note that we can't call Is_RTU on
+ -- Ada_Strings_Text_Buffers, because it's not known yet (we might be
-- compiling it). But this is insufficient to allow support for tagged
-- predefined types.
@@ -873,7 +877,7 @@ package body Exp_Put_Image is
begin
if Present (Parent_Scope)
and then Is_RTU (Parent_Scope, Ada_Strings)
- and then Chars (Scope (Typ)) = Name_Find ("text_output")
+ and then Chars (Scope (Typ)) = Name_Find ("text_buffers")
then
return False;
end if;
@@ -964,11 +968,8 @@ package body Exp_Put_Image is
Make_Object_Declaration (Loc,
Defining_Identifier => Sink_Entity,
Object_Definition =>
- New_Occurrence_Of (RTE (RE_Buffer), Loc),
- Expression =>
- Make_Function_Call (Loc,
- Name => New_Occurrence_Of (RTE (RE_New_Buffer), Loc),
- Parameter_Associations => Empty_List));
+ New_Occurrence_Of (RTE (RE_Buffer_Type), Loc));
+
Put_Im : constant Node_Id :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (U_Type, Loc),
@@ -996,15 +997,16 @@ package body Exp_Put_Image is
return Image;
end Build_Image_Call;
- ------------------
- -- Preload_Sink --
- ------------------
+ ------------------------------
+ -- Preload_Root_Buffer_Type --
+ ------------------------------
- procedure Preload_Sink (Compilation_Unit : Node_Id) is
+ procedure Preload_Root_Buffer_Type (Compilation_Unit : Node_Id) is
begin
- -- We can't call RTE (RE_Sink) for at least some predefined units,
- -- because it would introduce cyclic dependences. The package where Sink
- -- is declared, for example, and things it depends on.
+ -- We can't call RTE (RE_Root_Buffer_Type) for at least some
+ -- predefined units, because it would introduce cyclic dependences.
+ -- The package where Root_Buffer_Type is declared, for example, and
+ -- things it depends on.
--
-- It's only needed for tagged types, so don't do it unless Put_Image is
-- enabled for tagged types, and we've seen a tagged type. Note that
@@ -1013,25 +1015,26 @@ package body Exp_Put_Image is
-- It's unfortunate to have this Tagged_Seen processing so scattered
-- about, but we need to know if there are tagged types where this is
-- called in Analyze_Compilation_Unit, before we have analyzed any type
- -- declarations. This mechanism also prevents doing RTE (RE_Sink) when
- -- compiling the compiler itself. Packages Ada.Strings.Text_Output and
- -- friends are not included in the compiler.
+ -- declarations. This mechanism also prevents doing
+ -- RTE (RE_Root_Buffer_Type) when compiling the compiler itself.
+ -- Packages Ada.Strings.Buffer_Types and friends are not included
+ -- in the compiler.
--
- -- Don't do it if type Sink is unavailable in the runtime.
+ -- Don't do it if type Root_Buffer_Type is unavailable in the runtime.
if not In_Predefined_Unit (Compilation_Unit)
and then Tagged_Put_Image_Enabled
and then Tagged_Seen
and then not No_Run_Time_Mode
- and then RTE_Available (RE_Sink)
+ and then RTE_Available (RE_Root_Buffer_Type)
then
declare
- Ignore : constant Entity_Id := RTE (RE_Sink);
+ Ignore : constant Entity_Id := RTE (RE_Root_Buffer_Type);
begin
null;
end;
end if;
- end Preload_Sink;
+ end Preload_Root_Buffer_Type;
-------------------------
-- Put_Image_Base_Type --
diff --git a/gcc/ada/exp_put_image.ads b/gcc/ada/exp_put_image.ads
index 7ef8eef59b7..4f049f131f3 100644
--- a/gcc/ada/exp_put_image.ads
+++ b/gcc/ada/exp_put_image.ads
@@ -27,8 +27,9 @@ with Types; use Types;
package Exp_Put_Image is
- -- Routines to build Put_Image calls. See Ada.Strings.Text_Output.Utils and
- -- System.Put_Images for the run-time routines we are generating calls to.
+ -- Routines to build Put_Image calls. See Ada.Strings.Text_Buffers.Utils
+ -- and System.Put_Images for the run-time routines we are generating calls
+ -- to.
-- For a call to T'Put_Image, if T is elementary, we expand the code
-- inline. If T is a tagged type, then Put_Image is a primitive procedure
@@ -94,10 +95,10 @@ package Exp_Put_Image is
-- to call T'Put_Image into a buffer and then extract the string from the
-- buffer.
- procedure Preload_Sink (Compilation_Unit : Node_Id);
- -- Call RTE (RE_Sink) if necessary, to load the packages involved in
- -- Put_Image. We need to do this explicitly, fairly early during
- -- compilation, because otherwise it happens during freezing, which
+ procedure Preload_Root_Buffer_Type (Compilation_Unit : Node_Id);
+ -- Call RTE (RE_Root_Buffer_Type) if necessary, to load the packages
+ -- involved in Put_Image. We need to do this explicitly, fairly early
+ -- during compilation, because otherwise it happens during freezing, which
-- triggers visibility bugs in generic instantiations.
end Exp_Put_Image;
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
index 7ef285ee458..6b48e8e8ca9 100644
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Ada.Containers; use type Ada.Containers.Count_Type;
+with Ada.Text_IO;
package body Gen_IL.Gen is
@@ -536,15 +537,15 @@ package body Gen_IL.Gen is
-- Print out the Einfo.Entities package spec and body
procedure Put_Type_And_Subtypes
- (S : in out Sink'Class; Root : Root_Type);
+ (S : in out Sink; Root : Root_Type);
-- Called by Put_Nodes and Put_Entities to print out the main type
-- and subtype declarations in Sinfo.Nodes and Einfo.Entities.
- procedure Put_Subp_Decls (S : in out Sink'Class; Root : Root_Type);
+ procedure Put_Subp_Decls (S : in out Sink; Root : Root_Type);
-- Called by Put_Nodes and Put_Entities to print out the subprogram
-- declarations in Sinfo.Nodes and Einfo.Entities.
- procedure Put_Subp_Bodies (S : in out Sink'Class; Root : Root_Type);
+ procedure Put_Subp_Bodies (S : in out Sink; Root : Root_Type);
-- Called by Put_Nodes and Put_Entities to print out the subprogram
-- bodies in Sinfo.Nodes and Einfo.Entities.
@@ -554,29 +555,29 @@ package body Gen_IL.Gen is
-- parameter N). But if Type_Only was specified, we need to fetch the
-- corresponding base (etc) type.
- procedure Put_Getter_Spec (S : in out Sink'Class; F : Field_Enum);
- procedure Put_Setter_Spec (S : in out Sink'Class; F : Field_Enum);
- procedure Put_Getter_Decl (S : in out Sink'Class; F : Field_Enum);
- procedure Put_Setter_Decl (S : in out Sink'Class; F : Field_Enum);
- procedure Put_Getter_Body (S : in out Sink'Class; F : Field_Enum);
- procedure Put_Setter_Body (S : in out Sink'Class; F : Field_Enum);
+ procedure Put_Getter_Spec (S : in out Sink; F : Field_Enum);
+ procedure Put_Setter_Spec (S : in out Sink; F : Field_Enum);
+ procedure Put_Getter_Decl (S : in out Sink; F : Field_Enum);
+ procedure Put_Setter_Decl (S : in out Sink; F : Field_Enum);
+ procedure Put_Getter_Body (S : in out Sink; F : Field_Enum);
+ procedure Put_Setter_Body (S : in out Sink; F : Field_Enum);
-- Print out the specification, declaration, or body of a getter or
-- setter for the given field.
procedure Put_Precondition
- (S : in out Sink'Class; F : Field_Enum);
+ (S : in out Sink; F : Field_Enum);
-- Print out the precondition, if any, for a getter or setter for the
-- given field.
procedure Put_Low_Level_Accessor_Instantiations
- (S : in out Sink'Class; T : Type_Enum);
+ (S : in out Sink; T : Type_Enum);
-- Print out the low-level getter and setter for a given type
- procedure Put_Traversed_Fields (S : in out Sink'Class);
+ procedure Put_Traversed_Fields (S : in out Sink);
-- Called by Put_Nodes to print out the Traversed_Fields table in
-- Sinfo.Nodes.
- procedure Put_Tables (S : in out Sink'Class; Root : Root_Type);
+ procedure Put_Tables (S : in out Sink; Root : Root_Type);
-- Called by Put_Nodes and Put_Entities to print out the various tables
-- in Sinfo.Nodes and Einfo.Entities.
@@ -584,14 +585,14 @@ package body Gen_IL.Gen is
-- Print out the Nmake package spec and body, containing
-- Make_... functions for each concrete node type.
- procedure Put_Make_Decls (S : in out Sink'Class; Root : Root_Type);
+ procedure Put_Make_Decls (S : in out Sink; Root : Root_Type);
-- Called by Put_Nmake to print out the Make_... function declarations
- procedure Put_Make_Bodies (S : in out Sink'Class; Root : Root_Type);
+ procedure Put_Make_Bodies (S : in out Sink; Root : Root_Type);
-- Called by Put_Nmake to print out the Make_... function bodies
procedure Put_Make_Spec
- (S : in out Sink'Class; Root : Root_Type; T : Concrete_Type);
+ (S : in out Sink; Root : Root_Type; T : Concrete_Type);
-- Called by Put_Make_Decls and Put_Make_Bodies to print out the spec of
-- a single Make_... function.
@@ -606,27 +607,27 @@ package body Gen_IL.Gen is
-- Print out the einfo.h file
procedure Put_C_Type_And_Subtypes
- (S : in out Sink'Class; Root : Root_Type);
+ (S : in out Sink; Root : Root_Type);
-- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out the C code
-- corresponding to the Ada Node_Kind, Entity_Kind, and subtypes
-- thereof.
procedure Put_Low_Level_C_Getter
- (S : in out Sink'Class; T : Type_Enum);
+ (S : in out Sink; T : Type_Enum);
-- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out low-level
-- getters.
procedure Put_High_Level_C_Getters
- (S : in out Sink'Class; Root : Root_Type);
+ (S : in out Sink; Root : Root_Type);
-- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out high-level
-- getters.
procedure Put_High_Level_C_Getter
- (S : in out Sink'Class; F : Field_Enum);
+ (S : in out Sink; F : Field_Enum);
-- Used by Put_High_Level_C_Getters to print out one high-level getter.
procedure Put_Union_Membership
- (S : in out Sink'Class; Root : Root_Type);
+ (S : in out Sink; Root : Root_Type);
-- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out functions to
-- test membership in a union type.
@@ -764,7 +765,8 @@ package body Gen_IL.Gen is
for F of Type_Table (CT).Fields loop
if Fields_Per_Node (CT) (F) then
- Put ("duplicate field \1.\2\n", Image (CT), Image (F));
+ Ada.Text_IO.Put_Line
+ ("duplicate field" & Image (CT) & Image (F));
Duplicate_Fields_Found := True;
end if;
@@ -1383,7 +1385,7 @@ package body Gen_IL.Gen is
---------------------------
procedure Put_Type_And_Subtypes
- (S : in out Sink'Class; Root : Root_Type)
+ (S : in out Sink; Root : Root_Type)
is
procedure Put_Enum_Type;
@@ -1411,10 +1413,10 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1", Image (T));
+ Put (S, Image (T));
end if;
end Put_Enum_Lit;
@@ -1423,14 +1425,15 @@ package body Gen_IL.Gen is
Num_Types : constant Root_Int := Dummy'Length;
begin
- Put (S, "type \1 is -- \2 \1s\n", Image (Root), Image (Num_Types));
- Indent (S, 2);
+ Put (S, "type " & Image (Root) & " is -- " &
+ Image (Num_Types) & " " & Image (Root) & "s" & LF);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
Iterate_Types (Root, Pre => Put_Enum_Lit'Access);
- Outdent (S, 1);
- Put (S, "\n) with Size => 8; -- \1\n\n", Image (Root));
- Outdent (S, 2);
+ Decrease_Indent (S, 1);
+ Put (S, LF & ") with Size => 8; -- " & Image (Root) & LF & LF);
+ Decrease_Indent (S, 2);
end Put_Enum_Type;
procedure Put_Kind_Subtype (T : Node_Or_Entity_Type) is
@@ -1439,35 +1442,32 @@ package body Gen_IL.Gen is
if Type_Table (T).Is_Union then
pragma Assert (Type_Table (T).Parent = Root);
- Put (S, "subtype \1 is\n", Image (T));
- Indent (S, 2);
- Put (S, "\1 with Predicate =>\n",
- Image (Root));
- Indent (S, 2);
- Put (S, "\1 in\n", Image (T));
+ Put (S, "subtype " & Image (T) & " is" & LF);
+ Increase_Indent (S, 2);
+ Put (S, Image (Root) & " with Predicate =>" & LF);
+ Increase_Indent (S, 2);
+ Put (S, Image (T) & " in" & LF);
Put_Types_With_Bars (S, Type_Table (T).Children);
- Outdent (S, 2);
- Put (S, ";\n");
- Outdent (S, 2);
+ Decrease_Indent (S, 2);
+ Put (S, ";" & LF);
+ Decrease_Indent (S, 2);
elsif Type_Table (T).Parent /= No_Type then
- Put (S, "subtype \1 is \2 range\n",
- Image (T),
- Image (Type_Table (T).Parent));
- Indent (S, 2);
- Put (S, "\1 .. \2;\n",
- Image (Type_Table (T).First),
- Image (Type_Table (T).Last));
- Outdent (S, 2);
+ Put (S, "subtype " & Image (T) & " is " &
+ Image (Type_Table (T).Parent) & " range" & LF);
+ Increase_Indent (S, 2);
+ Put (S, Image (Type_Table (T).First) & " .. " &
+ Image (Type_Table (T).Last) & ";" & LF);
+ Decrease_Indent (S, 2);
- Indent (S, 3);
+ Increase_Indent (S, 3);
for J in 1 .. Type_Table (T).Concrete_Descendants.Last_Index loop
- Put (S, "-- \1\n",
- Image (Type_Table (T).Concrete_Descendants (J)));
+ Put (S, "-- " &
+ Image (Type_Table (T).Concrete_Descendants (J)) & LF);
end loop;
- Outdent (S, 3);
+ Decrease_Indent (S, 3);
end if;
end if;
end Put_Kind_Subtype;
@@ -1475,19 +1475,19 @@ package body Gen_IL.Gen is
procedure Put_Id_Subtype (T : Node_Or_Entity_Type) is
begin
if Type_Table (T).Parent /= No_Type then
- Put (S, "subtype \1 is\n", Id_Image (T));
- Indent (S, 2);
- Put (S, "\1", Id_Image (Type_Table (T).Parent));
+ Put (S, "subtype " & Id_Image (T) & " is" & LF);
+ Increase_Indent (S, 2);
+ Put (S, Id_Image (Type_Table (T).Parent));
if Enable_Assertions then
- Put (S, " with Predicate =>\n");
- Indent (S, 2);
- Put (S, "K (\1) in \2", Id_Image (T), Image (T));
- Outdent (S, 2);
+ Put (S, " with Predicate =>" & LF);
+ Increase_Indent (S, 2);
+ Put (S, "K (" & Id_Image (T) & ") in " & Image (T));
+ Decrease_Indent (S, 2);
end if;
- Put (S, ";\n");
- Outdent (S, 2);
+ Put (S, ";" & LF);
+ Decrease_Indent (S, 2);
end if;
end Put_Id_Subtype;
@@ -1501,48 +1501,45 @@ package body Gen_IL.Gen is
case Root is
when Node_Kind =>
Put_Getter_Decl (S, Nkind);
- Put (S, "function K (N : Node_Id) return Node_Kind renames Nkind;\n");
- Put (S, "-- Shorthand for use in predicates and preconditions below\n");
- Put (S, "-- There is no procedure Set_Nkind.\n");
- Put (S, "-- See Init_Nkind and Mutate_Nkind in Atree.\n\n");
+ Put (S, "function K (N : Node_Id) return Node_Kind renames Nkind;" & LF);
+ Put (S, "-- Shorthand for use in predicates and preconditions below" & LF);
+ Put (S, "-- There is no procedure Set_Nkind." & LF);
+ Put (S, "-- See Init_Nkind and Mutate_Nkind in Atree." & LF & LF);
when Entity_Kind =>
Put_Getter_Decl (S, Ekind);
- Put (S, "function K (N : Entity_Id) return Entity_Kind renames Ekind;\n");
- Put (S, "-- Shorthand for use in predicates and preconditions below\n");
- Put (S, "-- There is no procedure Set_Ekind here.\n");
- Put (S, "-- See Mutate_Ekind in Atree.\n\n");
+ Put (S, "function K (N : Entity_Id) return Entity_Kind renames Ekind;" & LF);
+ Put (S, "-- Shorthand for use in predicates and preconditions below" & LF);
+ Put (S, "-- There is no procedure Set_Ekind here." & LF);
+ Put (S, "-- See Mutate_Ekind in Atree." & LF & LF);
when others => raise Program_Error;
end case;
- Put (S, "-- Subtypes of \1 for each abstract type:\n\n",
- Image (Root));
+ Put (S, "-- Subtypes of " & Image (Root) & " for each abstract type:" & LF & LF);
- Put (S, "pragma Style_Checks (""M200"");\n");
+ Put (S, "pragma Style_Checks (""M200"");" & LF);
Iterate_Types (Root, Pre => Put_Kind_Subtype'Access);
- Put (S, "\n-- Subtypes of \1 with specified \2.\n",
- Id_Image (Root), Image (Root));
- Put (S, "-- These may be used in place of \1 for better documentation,\n",
- Id_Image (Root));
- Put (S, "-- and if assertions are enabled, for run-time checking.\n\n");
+ Put (S, LF & "-- Subtypes of " & Id_Image (Root) &
+ " with specified " & Image (Root) & "." & LF);
+ Put (S, "-- These may be used in place of " & Id_Image (Root) &
+ " for better documentation," & LF);
+ Put (S, "-- and if assertions are enabled, for run-time checking." & LF & LF);
Iterate_Types (Root, Pre => Put_Id_Subtype'Access);
- Put (S, "\n");
- Put (S, "-- Union types (nonhierarchical subtypes of \1)\n\n",
- Id_Image (Root));
+ Put (S, LF & "-- Union types (nonhierarchical subtypes of " &
+ Id_Image (Root) & ")" & LF & LF);
for T in First_Abstract (Root) .. Last_Abstract (Root) loop
if Type_Table (T) /= null and then Type_Table (T).Is_Union then
Put_Kind_Subtype (T);
Put_Id_Subtype (T);
- Put (S, "\n");
end if;
end loop;
- Put (S, "subtype Flag is Boolean;\n\n");
+ Put (S, "subtype Flag is Boolean;" & LF & LF);
end Put_Type_And_Subtypes;
function Low_Level_Getter_Name (T : Type_Enum) return String is
@@ -1558,7 +1555,7 @@ package body Gen_IL.Gen is
-------------------------------------------
procedure Put_Low_Level_Accessor_Instantiations
- (S : in out Sink'Class; T : Type_Enum)
+ (S : in out Sink; T : Type_Enum)
is
begin
-- Special case for types that have defaults; instantiate
@@ -1572,39 +1569,34 @@ package body Gen_IL.Gen is
(if T = Elist_Id then "No_Elist" else "Uint_0");
begin
- Put (S, "\nfunction \1 is new Get_32_Bit_Field_With_Default (\2, \3) with \4;\n",
- Low_Level_Getter_Name (T),
- Get_Set_Id_Image (T),
- Default_Val,
- Inline);
+ Put (S, LF & "function " & Low_Level_Getter_Name (T) &
+ " is new Get_32_Bit_Field_With_Default (" &
+ Get_Set_Id_Image (T) & ", " & Default_Val &
+ ") with " & Inline & ";" & LF);
end;
-- Otherwise, instantiate the normal getter for the right size in
-- bits.
else
- Put (S, "\nfunction \1 is new Get_\2_Bit_Field (\3) with \4;\n",
- Low_Level_Getter_Name (T),
- Image (Field_Size (T)),
- Get_Set_Id_Image (T),
- Inline);
+ Put (S, LF & "function " & Low_Level_Getter_Name (T) &
+ " is new Get_" & Image (Field_Size (T)) & "_Bit_Field (" &
+ Get_Set_Id_Image (T) & ") with " & Inline & ";" & LF);
end if;
-- No special case for the setter
if T in Node_Kind_Type | Entity_Kind_Type then
- Put (S, "pragma Warnings (Off);\n");
+ Put (S, "pragma Warnings (Off);" & LF);
-- Set_Node_Kind_Type and Set_Entity_Kind_Type might not be called
end if;
- Put (S, "procedure \1 is new Set_\2_Bit_Field (\3) with \4;\n",
- Low_Level_Setter_Name (T),
- Image (Field_Size (T)),
- Get_Set_Id_Image (T),
- Inline);
+ Put (S, "procedure " & Low_Level_Setter_Name (T) & " is new Set_" &
+ Image (Field_Size (T)) & "_Bit_Field (" & Get_Set_Id_Image (T) &
+ ") with " & Inline & ";" & LF);
if T in Node_Kind_Type | Entity_Kind_Type then
- Put (S, "pragma Warnings (On);\n");
+ Put (S, "pragma Warnings (On);" & LF);
end if;
end Put_Low_Level_Accessor_Instantiations;
@@ -1613,7 +1605,7 @@ package body Gen_IL.Gen is
----------------------
procedure Put_Precondition
- (S : in out Sink'Class; F : Field_Enum)
+ (S : in out Sink; F : Field_Enum)
is
-- If the field is present in all entities, we want to assert that
-- N in N_Entity_Id. If the field is present in only some entities,
@@ -1638,21 +1630,21 @@ package body Gen_IL.Gen is
or else Field_Table (F).Have_This_Field = Nodes_And_Entities
then
if Is_Entity /= "" then
- Indent (S, 1);
- Put (S, ", Pre =>\n");
- Put (S, "\1", Is_Entity);
- Outdent (S, 1);
+ Increase_Indent (S, 1);
+ Put (S, ", Pre =>" & LF);
+ Put (S, Is_Entity);
+ Decrease_Indent (S, 1);
end if;
else
- Put (S, ", Pre =>\n");
- Indent (S, 1);
+ Put (S, ", Pre =>" & LF);
+ Increase_Indent (S, 1);
Put (S, "N in ");
Put_Type_Ids_With_Bars (S, Field_Table (F).Have_This_Field);
pragma Assert (Is_Entity = "");
- Outdent (S, 1);
+ Decrease_Indent (S, 1);
end if;
end if;
end Put_Precondition;
@@ -1691,35 +1683,35 @@ package body Gen_IL.Gen is
-- Put_Getter_Spec --
---------------------
- procedure Put_Getter_Spec (S : in out Sink'Class; F : Field_Enum) is
+ procedure Put_Getter_Spec (S : in out Sink; F : Field_Enum) is
begin
- Put (S, "function \1\n", Image (F));
- Indent (S, 2);
- Put (S, "(N : \1) return \2",
- N_Type (F), Get_Set_Id_Image (Field_Table (F).Field_Type));
- Outdent (S, 2);
+ Put (S, "function " & Image (F) & LF);
+ Increase_Indent (S, 2);
+ Put (S, "(N : " & N_Type (F) & ") return " &
+ Get_Set_Id_Image (Field_Table (F).Field_Type));
+ Decrease_Indent (S, 2);
end Put_Getter_Spec;
---------------------
-- Put_Getter_Decl --
---------------------
- procedure Put_Getter_Decl (S : in out Sink'Class; F : Field_Enum) is
+ procedure Put_Getter_Decl (S : in out Sink; F : Field_Enum) is
begin
Put_Getter_Spec (S, F);
- Put (S, " with \1", Inline);
- Indent (S, 2);
+ Put (S, " with " & Inline);
+ Increase_Indent (S, 2);
Put_Precondition (S, F);
- Outdent (S, 2);
- Put (S, ";\n");
+ Decrease_Indent (S, 2);
+ Put (S, ";" & LF);
end Put_Getter_Decl;
---------------------
-- Put_Getter_Body --
---------------------
- procedure Put_Getter_Body (S : in out Sink'Class; F : Field_Enum) is
+ procedure Put_Getter_Body (S : in out Sink; F : Field_Enum) is
Rec : Field_Info renames Field_Table (F).all;
begin
-- Note that we store the result in a local constant below, so that
@@ -1729,66 +1721,64 @@ package body Gen_IL.Gen is
-- and setter.
Put_Getter_Spec (S, F);
- Put (S, " is\n");
- Indent (S, 3);
- Put (S, "Val : constant \1 := \2 (\3, \4);\n",
- Get_Set_Id_Image (Rec.Field_Type),
- Low_Level_Getter_Name (Rec.Field_Type),
- Node_To_Fetch_From (F),
- Image (Rec.Offset));
- Outdent (S, 3);
- Put (S, "begin\n");
- Indent (S, 3);
+ Put (S, " is" & LF);
+ Increase_Indent (S, 3);
+ Put (S, "Val : constant " & Get_Set_Id_Image (Rec.Field_Type) &
+ " := " & Low_Level_Getter_Name (Rec.Field_Type) &
+ " (" & Node_To_Fetch_From (F) & ", " &
+ Image (Rec.Offset) & ");" & LF);
+ Decrease_Indent (S, 3);
+ Put (S, "begin" & LF);
+ Increase_Indent (S, 3);
if Rec.Pre.all /= "" then
- Put (S, "pragma Assert (\1);\n", Rec.Pre.all);
+ Put (S, "pragma Assert (" & Rec.Pre.all & ");" & LF);
end if;
if Rec.Pre_Get.all /= "" then
- Put (S, "pragma Assert (\1);\n", Rec.Pre_Get.all);
+ Put (S, "pragma Assert (" & Rec.Pre_Get.all & ");" & LF);
end if;
- Put (S, "return Val;\n");
- Outdent (S, 3);
- Put (S, "end \1;\n\n", Image (F));
+ Put (S, "return Val;" & LF);
+ Decrease_Indent (S, 3);
+ Put (S, "end " & Image (F) & ";" & LF & LF);
end Put_Getter_Body;
---------------------
-- Put_Setter_Spec --
---------------------
- procedure Put_Setter_Spec (S : in out Sink'Class; F : Field_Enum) is
+ procedure Put_Setter_Spec (S : in out Sink; F : Field_Enum) is
Rec : Field_Info renames Field_Table (F).all;
Default : constant String :=
(if Rec.Field_Type = Flag then " := True" else "");
begin
- Put (S, "procedure Set_\1\n", Image (F));
- Indent (S, 2);
- Put (S, "(N : \1; Val : \2\3)",
- N_Type (F), Get_Set_Id_Image (Rec.Field_Type),
- Default);
- Outdent (S, 2);
+ Put (S, "procedure Set_" & Image (F) & LF);
+ Increase_Indent (S, 2);
+ Put (S, "(N : " & N_Type (F) & "; Val : " &
+ Get_Set_Id_Image (Rec.Field_Type) & Default & ")");
+ Decrease_Indent (S, 2);
end Put_Setter_Spec;
---------------------
-- Put_Setter_Decl --
---------------------
- procedure Put_Setter_Decl (S : in out Sink'Class; F : Field_Enum) is
+ procedure Put_Setter_Decl (S : in out Sink; F : Field_Enum) is
begin
Put_Setter_Spec (S, F);
- Put (S, " with \1", Inline);
- Indent (S, 2);
+ Put (S, " with " & Inline);
+ Increase_Indent (S, 2);
Put_Precondition (S, F);
- Outdent (S, 2);
- Put (S, ";\n");
+ Decrease_Indent (S, 2);
+ Put (S, ";" & LF);
end Put_Setter_Decl;
---------------------
-- Put_Setter_Body --
---------------------
- procedure Put_Setter_Body (S : in out Sink'Class; F : Field_Enum) is
+ procedure Put_Setter_Body (S : in out Sink; F : Field_Enum) is
Rec : Field_Info renames Field_Table (F).all;
-- If Type_Only was specified in the call to Create_Semantic_Field,
@@ -1802,58 +1792,57 @@ package body Gen_IL.Gen is
"Is_Base_Type (N)");
begin
Put_Setter_Spec (S, F);
- Put (S, " is\n");
- Put (S, "begin\n");
- Indent (S, 3);
+ Put (S, " is" & LF);
+ Put (S, "begin" & LF);
+ Increase_Indent (S, 3);
if Rec.Pre.all /= "" then
- Put (S, "pragma Assert (\1);\n", Rec.Pre.all);
+ Put (S, "pragma Assert (" & Rec.Pre.all & ");" & LF);
end if;
if Rec.Pre_Set.all /= "" then
- Put (S, "pragma Assert (\1);\n", Rec.Pre_Set.all);
+ Put (S, "pragma Assert (" & Rec.Pre_Set.all & ");" & LF);
end if;
if Type_Only_Assertion /= "" then
- Put (S, "pragma Assert (\1);\n", Type_Only_Assertion);
+ Put (S, "pragma Assert (" & Type_Only_Assertion & ");" & LF);
end if;
- Put (S, "\1 (N, \2, Val);\n",
- Low_Level_Setter_Name (F),
- Image (Rec.Offset));
- Outdent (S, 3);
- Put (S, "end Set_\1;\n\n", Image (F));
+ Put (S, Low_Level_Setter_Name (F) & " (N, " & Image (Rec.Offset)
+ & ", Val);" & LF);
+ Decrease_Indent (S, 3);
+ Put (S, "end Set_" & Image (F) & ";" & LF & LF);
end Put_Setter_Body;
--------------------
-- Put_Subp_Decls --
--------------------
- procedure Put_Subp_Decls (S : in out Sink'Class; Root : Root_Type) is
+ procedure Put_Subp_Decls (S : in out Sink; Root : Root_Type) is
-- Note that there are several fields that are defined for both nodes
-- and entities, such as Nkind. These are allocated slots in both,
-- but here we only put out getters and setters in Sinfo.Nodes, not
-- Einfo.Entities.
begin
- Put (S, "-- Getters and setters for fields\n");
+ Put (S, "-- Getters and setters for fields" & LF);
for F in First_Field (Root) .. Last_Field (Root) loop
-- Nkind/Ekind getter is already done (see Put_Type_And_Subtypes),
-- and there is no setter for these.
if F = Nkind then
- Put (S, "\n-- Nkind getter is above\n");
+ Put (S, LF & "-- Nkind getter is above" & LF);
elsif F = Ekind then
- Put (S, "\n-- Ekind getter is above\n");
+ Put (S, LF & "-- Ekind getter is above" & LF);
else
Put_Getter_Decl (S, F);
Put_Setter_Decl (S, F);
end if;
- Put (S, "\n");
+ Put (S, LF);
end loop;
end Put_Subp_Decls;
@@ -1861,9 +1850,9 @@ package body Gen_IL.Gen is
-- Put_Subp_Bodies --
---------------------
- procedure Put_Subp_Bodies (S : in out Sink'Class; Root : Root_Type) is
+ procedure Put_Subp_Bodies (S : in out Sink; Root : Root_Type) is
begin
- Put (S, "\n-- Getters and setters for fields\n\n");
+ Put (S, LF & "-- Getters and setters for fields" & LF & LF);
for F in First_Field (Root) .. Last_Field (Root) loop
Put_Getter_Body (S, F);
@@ -1878,7 +1867,7 @@ package body Gen_IL.Gen is
-- Put_Traversed_Fields --
--------------------------
- procedure Put_Traversed_Fields (S : in out Sink'Class) is
+ procedure Put_Traversed_Fields (S : in out Sink) is
function Is_Traversed_Field
(T : Concrete_Node; F : Field_Enum) return Boolean;
@@ -1909,11 +1898,11 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1 => (", Image (T));
- Indent (S, 2);
+ Put (S, Image (T) & " => (");
+ Increase_Indent (S, 2);
for FI in 1 .. Last_Index (Type_Table (T).Fields) loop
declare
@@ -1925,7 +1914,7 @@ package body Gen_IL.Gen is
Left_Opnd_Skipped := True; -- see comment below
else
- Put (S, "\1, ", Image (Field_Table (F).Offset));
+ Put (S, Image (Field_Table (F).Offset) & ", ");
end if;
end if;
end;
@@ -1937,12 +1926,12 @@ package body Gen_IL.Gen is
-- that.
if Left_Opnd_Skipped then
- Put (S, "\1, ", Image (Field_Table (Left_Opnd).Offset));
+ Put (S, Image (Field_Table (Left_Opnd).Offset) & ", ");
end if;
Put (S, "others => No_Field_Offset");
- Outdent (S, 2);
+ Decrease_Indent (S, 2);
Put (S, ")");
end if;
end Put_Aggregate;
@@ -1979,29 +1968,29 @@ package body Gen_IL.Gen is
Init_Max_Traversed_Fields;
begin
- Put (S, "-- Table of fields that should be traversed by Traverse subprograms.\n");
- Put (S, "-- Each entry is an array of offsets in slots of fields to be\n");
- Put (S, "-- traversed, terminated by a sentinel equal to No_Field_Offset.\n\n");
+ Put (S, "-- Table of fields that should be traversed by Traverse subprograms." & LF);
+ Put (S, "-- Each entry is an array of offsets in slots of fields to be" & LF);
+ Put (S, "-- traversed, terminated by a sentinel equal to No_Field_Offset." & LF & LF);
- Put (S, "subtype Traversed_Offset_Array is Offset_Array (0 .. \1 + 1);\n",
- Image (Max_Traversed_Fields - 1));
- Put (S, "Traversed_Fields : constant array (Node_Kind) of Traversed_Offset_Array :=\n");
+ Put (S, "subtype Traversed_Offset_Array is Offset_Array (0 .. " &
+ Image (Max_Traversed_Fields - 1) & " + 1);" & LF);
+ Put (S, "Traversed_Fields : constant array (Node_Kind) of Traversed_Offset_Array :=" & LF);
-- One extra for the sentinel
- Indent (S, 2);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
Iterate_Types (Node_Kind, Pre => Put_Aggregate'Access);
- Outdent (S, 1);
- Put (S, ");\n\n");
- Outdent (S, 2);
+ Decrease_Indent (S, 1);
+ Put (S, ");" & LF & LF);
+ Decrease_Indent (S, 2);
end Put_Traversed_Fields;
----------------
-- Put_Tables --
----------------
- procedure Put_Tables (S : in out Sink'Class; Root : Root_Type) is
+ procedure Put_Tables (S : in out Sink; Root : Root_Type) is
First_Time : Boolean := True;
@@ -2012,10 +2001,10 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1 => \2", Image (T), Image (Type_Size_In_Slots (T)));
+ Put (S, Image (T) & " => " & Image (Type_Size_In_Slots (T)));
end if;
end Put_Size;
@@ -2029,10 +2018,10 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1", F_Image (F));
+ Put (S, F_Image (F));
end if;
end loop;
end Put_Field_Array;
@@ -2043,35 +2032,36 @@ package body Gen_IL.Gen is
when others => "Entity_Field"); -- Entity_Kind
begin
- Put (S, "-- Table of sizes in 32-bit slots for given \1, for use by Atree:\n",
- Image (Root));
+ Put (S, "-- Table of sizes in 32-bit slots for given " &
+ Image (Root) & ", for use by Atree:" & LF);
case Root is
when Node_Kind =>
- Put (S, "\nMin_Node_Size : constant Field_Offset := \1;\n",
- Image (Min_Node_Size));
- Put (S, "Max_Node_Size : constant Field_Offset := \1;\n\n",
- Image (Max_Node_Size));
- Put (S, "Average_Node_Size_In_Slots : constant := \1;\n\n",
- Average_Node_Size_In_Slots'Img);
+ Put (S, LF & "Min_Node_Size : constant Field_Offset := " &
+ Image (Min_Node_Size) & ";" & LF);
+ Put (S, "Max_Node_Size : constant Field_Offset := " &
+ Image (Max_Node_Size) & ";" & LF & LF);
+ Put (S, "Average_Node_Size_In_Slots : constant := " &
+ Average_Node_Size_In_Slots'Img & ";" & LF & LF);
when Entity_Kind =>
- Put (S, "\nMin_Entity_Size : constant Field_Offset := \1;\n",
- Image (Min_Entity_Size));
- Put (S, "Max_Entity_Size : constant Field_Offset := \1;\n\n",
- Image (Max_Entity_Size));
+ Put (S, LF & "Min_Entity_Size : constant Field_Offset := " &
+ Image (Min_Entity_Size) & ";" & LF);
+ Put (S, "Max_Entity_Size : constant Field_Offset := " &
+ Image (Max_Entity_Size) & ";" & LF & LF);
when others => raise Program_Error;
end case;
- Put (S, "Size : constant array (\1) of Field_Offset :=\n", Image (Root));
- Indent (S, 2);
+ Put (S, "Size : constant array (" & Image (Root) &
+ ") of Field_Offset :=" & LF);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
Iterate_Types (Root, Pre => Put_Size'Access);
- Outdent (S, 1);
- Put (S, "); -- Size\n");
- Outdent (S, 2);
+ Decrease_Indent (S, 1);
+ Put (S, "); -- Size" & LF);
+ Decrease_Indent (S, 2);
declare
type Dummy is array
@@ -2079,35 +2069,37 @@ package body Gen_IL.Gen is
Num_Fields : constant Root_Int := Dummy'Length;
First_Time : Boolean := True;
begin
- Put (S, "\n-- Enumeration of all \1 fields:\n\n",
- Image (Num_Fields));
+ Put (S, LF & "-- Enumeration of all " & Image (Num_Fields)
+ & " fields:" & LF & LF);
- Put (S, "type \1 is\n", Field_Enum_Type_Name);
- Indent (S, 2);
+ Put (S, "type " & Field_Enum_Type_Name & " is" & LF);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
for F in First_Field (Root) .. Last_Field (Root) loop
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1", F_Image (F));
+ Put (S, F_Image (F));
end loop;
- Outdent (S, 1);
- Put (S, "); -- \1\n", Field_Enum_Type_Name);
- Outdent (S, 2);
+ Decrease_Indent (S, 1);
+ Put (S, "); -- " & Field_Enum_Type_Name & LF);
+ Decrease_Indent (S, 2);
end;
- Put (S, "\ntype \1_Index is new Pos;\n", Field_Enum_Type_Name);
- Put (S, "type \1_Array is array (\1_Index range <>) of \1;\n",
- Field_Enum_Type_Name);
- Put (S, "type \1_Array_Ref is access constant \1_Array;\n",
- Field_Enum_Type_Name);
- Put (S, "subtype A is \1_Array;\n", Field_Enum_Type_Name);
+ Put (S, LF & "type " & Field_Enum_Type_Name & "_Index is new Pos;" & LF);
+ Put (S, "type " & Field_Enum_Type_Name & "_Array is array (" &
+ Field_Enum_Type_Name & "_Index range <>) of " &
+ Field_Enum_Type_Name & ";" & LF);
+ Put (S, "type " & Field_Enum_Type_Name &
+ "_Array_Ref is access constant " & Field_Enum_Type_Name &
+ "_Array;" & LF);
+ Put (S, "subtype A is " & Field_Enum_Type_Name & "_Array;" & LF);
-- Short name to make allocators below more readable
declare
@@ -2120,67 +2112,70 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1 =>\n", Image (T));
- Indent (S, 2);
+ Put (S, Image (T) & " =>" & LF);
+ Increase_Indent (S, 2);
Put (S, "new A'(");
- Indent (S, 6);
- Indent (S, 1);
+ Increase_Indent (S, 6);
+ Increase_Indent (S, 1);
Put_Field_Array (T);
- Outdent (S, 1);
+ Decrease_Indent (S, 1);
Put (S, ")");
- Outdent (S, 6);
- Outdent (S, 2);
+ Decrease_Indent (S, 6);
+ Decrease_Indent (S, 2);
end if;
end Do_One_Type;
begin
- Put (S, "\n-- Table mapping \1s to the sequence of fields that exist in that \1:\n\n",
- Image (Root));
+ Put (S, LF & "-- Table mapping " & Image (Root) &
+ "s to the sequence of fields that exist in that " &
+ Image (Root) & ":" & LF & LF);
- Put (S, "\1_Table : constant array (\2) of \1_Array_Ref :=\n",
- Field_Enum_Type_Name, Image (Root));
+ Put (S, Field_Enum_Type_Name & "_Table : constant array (" &
+ Image (Root) & ") of " & Field_Enum_Type_Name &
+ "_Array_Ref :=" & LF);
- Indent (S, 2);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
Iterate_Types (Root, Pre => Do_One_Type'Access);
- Outdent (S, 1);
- Put (S, "); -- \1_Table\n", Field_Enum_Type_Name);
- Outdent (S, 2);
+ Decrease_Indent (S, 1);
+ Put (S, "); -- " & Field_Enum_Type_Name & "_Table" & LF);
+ Decrease_Indent (S, 2);
end;
declare
First_Time : Boolean := True;
begin
- Put (S, "\n-- Table mapping fields to kind and offset:\n\n");
+ Put (S, LF & "-- Table mapping fields to kind and offset:" & LF & LF);
- Put (S, "\1_Descriptors : constant array (\1) of Field_Descriptor :=\n",
- Field_Enum_Type_Name);
+ Put (S, Field_Enum_Type_Name & "_Descriptors : constant array (" &
+ Field_Enum_Type_Name & ") of Field_Descriptor :=" & LF);
- Indent (S, 2);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
for F in First_Field (Root) .. Last_Field (Root) loop
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1 => (\2_Field, \3)", F_Image (F),
- Image (Field_Table (F).Field_Type), Image (Field_Table (F).Offset));
+ Put (S, F_Image (F) & " => (" &
+ Image (Field_Table (F).Field_Type) & "_Field, " &
+ Image (Field_Table (F).Offset) & ")");
end loop;
- Outdent (S, 1);
- Put (S, "); -- Field_Descriptors\n");
- Outdent (S, 2);
+ Decrease_Indent (S, 1);
+ Put (S, "); -- Field_Descriptors" & LF);
+ Decrease_Indent (S, 2);
end;
end Put_Tables;
@@ -2190,20 +2185,21 @@ package body Gen_IL.Gen is
----------------
procedure Put_Seinfo is
- S : Sink'Class := Create_File ("seinfo.ads");
+ S : Sink;
begin
- Put (S, "with Types; use Types;\n");
- Put (S, "\npackage Seinfo is\n\n");
- Indent (S, 3);
+ Create_File (S, "seinfo.ads");
+ Put (S, "with Types; use Types;" & LF);
+ Put (S, LF & "package Seinfo is" & LF & LF);
+ Increase_Indent (S, 3);
- Put (S, "-- This package is automatically generated.\n\n");
+ Put (S, "-- This package is automatically generated." & LF & LF);
- Put (S, "-- Common declarations visible in both Sinfo.Nodes and Einfo.Entities.\n");
+ Put (S, "-- Common declarations visible in both Sinfo.Nodes and Einfo.Entities." & LF);
- Put (S, "\ntype Field_Kind is\n");
- Indent (S, 2);
+ Put (S, LF & "type Field_Kind is" & LF);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
declare
First_Time : Boolean := True;
@@ -2212,21 +2208,21 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1_Field", Image (T));
+ Put (S, Image (T) & "_Field");
end loop;
end;
- Outdent (S, 1);
- Outdent (S, 2);
- Put (S, ");\n");
+ Decrease_Indent (S, 1);
+ Decrease_Indent (S, 2);
+ Put (S, ");" & LF);
- Put (S, "\nField_Size : constant array (Field_Kind) of Field_Size_In_Bits :=\n");
- Indent (S, 2);
+ Put (S, LF & "Field_Size : constant array (Field_Kind) of Field_Size_In_Bits :=" & LF);
+ Increase_Indent (S, 2);
Put (S, "(");
- Indent (S, 1);
+ Increase_Indent (S, 1);
declare
First_Time : Boolean := True;
@@ -2235,26 +2231,26 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, ",\n");
+ Put (S, "," & LF);
end if;
- Put (S, "\1_Field => \2", Image (T), Image (Field_Size (T)));
+ Put (S, Image (T) & "_Field => " & Image (Field_Size (T)));
end loop;
end;
- Outdent (S, 1);
- Outdent (S, 2);
- Put (S, ");\n\n");
+ Decrease_Indent (S, 1);
+ Decrease_Indent (S, 2);
+ Put (S, ");" & LF & LF);
- Put (S, "type Field_Descriptor is record\n");
- Indent (S, 3);
- Put (S, "Kind : Field_Kind;\n");
- Put (S, "Offset : Field_Offset;\n");
- Outdent (S, 3);
- Put (S, "end record;\n");
+ Put (S, "type Field_Descriptor is record" & LF);
+ Increase_Indent (S, 3);
+ Put (S, "Kind : Field_Kind;" & LF);
+ Put (S, "Offset : Field_Offset;" & LF);
+ Decrease_Indent (S, 3);
+ Put (S, "end record;" & LF);
- Outdent (S, 3);
- Put (S, "\nend Seinfo;\n");
+ Decrease_Indent (S, 3);
+ Put (S, LF & "end Seinfo;" & LF);
end Put_Seinfo;
---------------
@@ -2262,8 +2258,8 @@ package body Gen_IL.Gen is
---------------
procedure Put_Nodes is
- S : Sink'Class := Create_File ("sinfo-nodes.ads");
- B : Sink'Class := Create_File ("sinfo-nodes.adb");
+ S : Sink;
+ B : Sink;
procedure Put_Setter_With_Parent (Kind : String);
-- Put the low-level ..._With_Parent setter. Kind is either "Node" or
@@ -2272,51 +2268,53 @@ package body Gen_IL.Gen is
procedure Put_Setter_With_Parent (Kind : String) is
Error : constant String := (if Kind = "Node" then "" else "_" & Kind);
begin
- Put (B, "\nprocedure Set_\1_Id_With_Parent\n", Kind);
- Indent (B, 2);
- Put (B, "(N : Node_Id; Offset : Field_Offset; Val : \1_Id);\n\n", Kind);
- Outdent (B, 2);
-
- Put (B, "procedure Set_\1_Id_With_Parent\n", Kind);
- Indent (B, 2);
- Put (B, "(N : Node_Id; Offset : Field_Offset; Val : \1_Id) is\n", Kind);
- Outdent (B, 2);
- Put (B, "begin\n");
- Indent (B, 3);
- Put (B, "if Present (Val) and then Val /= Error\1 then\n", Error);
- Indent (B, 3);
- Put (B, "pragma Warnings (Off, ""actuals for this call may be in wrong order"");\n");
- Put (B, "Set_Parent (Val, N);\n");
- Put (B, "pragma Warnings (On, ""actuals for this call may be in wrong order"");\n");
- Outdent (B, 3);
- Put (B, "end if;\n\n");
-
- Put (B, "Set_\1_Id (N, Offset, Val);\n", Kind);
- Outdent (B, 3);
- Put (B, "end Set_\1_Id_With_Parent;\n", Kind);
+ Put (B, LF & "procedure Set_" & Kind & "_Id_With_Parent" & LF);
+ Increase_Indent (B, 2);
+ Put (B, "(N : Node_Id; Offset : Field_Offset; Val : " & Kind & "_Id);" & LF & LF);
+ Decrease_Indent (B, 2);
+
+ Put (B, "procedure Set_" & Kind & "_Id_With_Parent" & LF);
+ Increase_Indent (B, 2);
+ Put (B, "(N : Node_Id; Offset : Field_Offset; Val : " & Kind & "_Id) is" & LF);
+ Decrease_Indent (B, 2);
+ Put (B, "begin" & LF);
+ Increase_Indent (B, 3);
+ Put (B, "if Present (Val) and then Val /= Error" & Error & " then" & LF);
+ Increase_Indent (B, 3);
+ Put (B, "pragma Warnings (Off, ""actuals for this call may be in wrong order"");" & LF);
+ Put (B, "Set_Parent (Val, N);" & LF);
+ Put (B, "pragma Warnings (On, ""actuals for this call may be in wrong order"");" & LF);
+ Decrease_Indent (B, 3);
+ Put (B, "end if;" & LF & LF);
+
+ Put (B, "Set_" & Kind & "_Id (N, Offset, Val);" & LF);
+ Decrease_Indent (B, 3);
+ Put (B, "end Set_" & Kind & "_Id_With_Parent;" & LF);
end Put_Setter_With_Parent;
-- Start of processing for Put_Nodes
begin
- Put (S, "with Seinfo; use Seinfo;\n");
- Put (S, "pragma Warnings (Off);\n");
+ Create_File (S, "sinfo-nodes.ads");
+ Create_File (B, "sinfo-nodes.adb");
+ Put (S, "with Seinfo; use Seinfo;" & LF);
+ Put (S, "pragma Warnings (Off);" & LF);
-- With's included in case they are needed; so we don't have to keep
-- switching back and forth.
- Put (S, "with Output; use Output;\n");
- Put (S, "pragma Warnings (On);\n");
+ Put (S, "with Output; use Output;" & LF);
+ Put (S, "pragma Warnings (On);" & LF);
- Put (S, "\npackage Sinfo.Nodes is\n\n");
- Indent (S, 3);
+ Put (S, LF & "package Sinfo.Nodes is" & LF & LF);
+ Increase_Indent (S, 3);
- Put (S, "-- This package is automatically generated.\n\n");
+ Put (S, "-- This package is automatically generated." & LF & LF);
Put_Type_Hierarchy (S, Node_Kind);
Put_Type_And_Subtypes (S, Node_Kind);
- Put (S, "pragma Assert (Node_Kind'Pos (N_Unused_At_Start) = 0);\n\n");
- Put (S, "pragma Assert (Node_Kind'Last = N_Unused_At_End);\n\n");
+ Put (S, "pragma Assert (Node_Kind'Pos (N_Unused_At_Start) = 0);" & LF & LF);
+ Put (S, "pragma Assert (Node_Kind'Last = N_Unused_At_End);" & LF & LF);
Put_Subp_Decls (S, Node_Kind);
@@ -2324,24 +2322,24 @@ package body Gen_IL.Gen is
Put_Tables (S, Node_Kind);
- Outdent (S, 3);
- Put (S, "\nend Sinfo.Nodes;\n");
+ Decrease_Indent (S, 3);
+ Put (S, LF & "end Sinfo.Nodes;" & LF);
- Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;\n");
- Put (B, "with Nlists; use Nlists;\n");
- Put (B, "pragma Warnings (Off);\n");
- Put (B, "with Einfo.Utils; use Einfo.Utils;\n");
- Put (B, "pragma Warnings (On);\n");
+ Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;" & LF);
+ Put (B, "with Nlists; use Nlists;" & LF);
+ Put (B, "pragma Warnings (Off);" & LF);
+ Put (B, "with Einfo.Utils; use Einfo.Utils;" & LF);
+ Put (B, "pragma Warnings (On);" & LF);
- Put (B, "\npackage body Sinfo.Nodes is\n\n");
- Indent (B, 3);
+ Put (B, LF & "package body Sinfo.Nodes is" & LF & LF);
+ Increase_Indent (B, 3);
- Put (B, "-- This package is automatically generated.\n\n");
+ Put (B, "-- This package is automatically generated." & LF & LF);
- Put (B, "-- Instantiations of low-level getters and setters that take offsets\n");
- Put (B, "-- in units of the size of the field.\n");
+ Put (B, "-- Instantiations of low-level getters and setters that take offsets" & LF);
+ Put (B, "-- in units of the size of the field." & LF);
- Put (B, "pragma Style_Checks (""M200"");\n");
+ Put (B, "pragma Style_Checks (""M200"");" & LF);
for T in Special_Type loop
if Node_Field_Types_Used (T) then
Put_Low_Level_Accessor_Instantiations (B, T);
@@ -2353,8 +2351,8 @@ package body Gen_IL.Gen is
Put_Subp_Bodies (B, Node_Kind);
- Outdent (B, 3);
- Put (B, "end Sinfo.Nodes;\n");
+ Decrease_Indent (B, 3);
+ Put (B, "end Sinfo.Nodes;" & LF);
end Put_Nodes;
@@ -2363,16 +2361,18 @@ package body Gen_IL.Gen is
------------------
procedure Put_Entities is
- S : Sink'Class := Create_File ("einfo-entities.ads");
- B : Sink'Class := Create_File ("einfo-entities.adb");
+ S : Sink;
+ B : Sink;
begin
- Put (S, "with Seinfo; use Seinfo;\n");
- Put (S, "with Sinfo.Nodes; use Sinfo.Nodes;\n");
+ Create_File (S, "einfo-entities.ads");
+ Create_File (B, "einfo-entities.adb");
+ Put (S, "with Seinfo; use Seinfo;" & LF);
+ Put (S, "with Sinfo.Nodes; use Sinfo.Nodes;" & LF);
- Put (S, "\npackage Einfo.Entities is\n\n");
- Indent (S, 3);
+ Put (S, LF & "package Einfo.Entities is" & LF & LF);
+ Increase_Indent (S, 3);
- Put (S, "-- This package is automatically generated.\n\n");
+ Put (S, "-- This package is automatically generated." & LF & LF);
Put_Type_Hierarchy (S, Entity_Kind);
@@ -2382,22 +2382,22 @@ package body Gen_IL.Gen is
Put_Tables (S, Entity_Kind);
- Outdent (S, 3);
- Put (S, "\nend Einfo.Entities;\n");
+ Decrease_Indent (S, 3);
+ Put (S, LF & "end Einfo.Entities;" & LF);
- Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;\n");
- Put (B, "with Einfo.Utils; use Einfo.Utils;\n");
+ Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;" & LF);
+ Put (B, "with Einfo.Utils; use Einfo.Utils;" & LF);
-- This forms a cycle between packages (via bodies, which is OK)
- Put (B, "\npackage body Einfo.Entities is\n\n");
- Indent (B, 3);
+ Put (B, LF & "package body Einfo.Entities is" & LF & LF);
+ Increase_Indent (B, 3);
- Put (B, "-- This package is automatically generated.\n\n");
+ Put (B, "-- This package is automatically generated." & LF & LF);
- Put (B, "-- Instantiations of low-level getters and setters that take offsets\n");
- Put (B, "-- in units of the size of the field.\n");
+ Put (B, "-- Instantiations of low-level getters and setters that take offsets" & LF);
+ Put (B, "-- in units of the size of the field." & LF);
- Put (B, "pragma Style_Checks (""M200"");\n");
+ Put (B, "pragma Style_Checks (""M200"");" & LF);
for T in Special_Type loop
if Entity_Field_Types_Used (T) then
Put_Low_Level_Accessor_Instantiations (B, T);
@@ -2406,8 +2406,8 @@ package body Gen_IL.Gen is
Put_Subp_Bodies (B, Entity_Kind);
- Outdent (B, 3);
- Put (B, "end Einfo.Entities;\n");
+ Decrease_Indent (B, 3);
+ Put (B, "end Einfo.Entities;" & LF);
end Put_Entities;
@@ -2416,13 +2416,13 @@ package body Gen_IL.Gen is
-------------------
procedure Put_Make_Spec
- (S : in out Sink'Class; Root : Root_Type; T : Concrete_Type)
+ (S : in out Sink; Root : Root_Type; T : Concrete_Type)
is
begin
- Put (S, "function Make_\1\n", Image_Sans_N (T));
- Indent (S, 2);
+ Put (S, "function Make_" & Image_Sans_N (T) & "" & LF);
+ Increase_Indent (S, 2);
Put (S, "(Sloc : Source_Ptr");
- Indent (S, 1);
+ Increase_Indent (S, 1);
for F of Type_Table (T).Fields loop
pragma Assert (Fields_Per_Node (T) (F));
@@ -2442,28 +2442,29 @@ package body Gen_IL.Gen is
else " := " & Value_Image (Field_Table (F).Default_Value));
begin
- Put (S, ";\n");
- Put (S, "\1", Image (F));
- Put (S, " : \1\2", Typ, Default);
+ Put (S, ";" & LF);
+ Put (S, Image (F));
+ Put (S, " : " & Typ & Default);
end;
end if;
end loop;
- Put (S, ")\nreturn \1_Id", Node_Or_Entity (Root));
- Outdent (S, 2);
- Outdent (S, 1);
+ Put (S, ")" & LF & "return " & Node_Or_Entity (Root) & "_Id");
+ Decrease_Indent (S, 2);
+ Decrease_Indent (S, 1);
end Put_Make_Spec;
--------------------
-- Put_Make_Decls --
--------------------
- procedure Put_Make_Decls (S : in out Sink'Class; Root : Root_Type) is
+ procedure Put_Make_Decls (S : in out Sink; Root : Root_Type) is
begin
for T in First_Concrete (Root) .. Last_Concrete (Root) loop
if T not in N_Unused_At_Start | N_Unused_At_End then
Put_Make_Spec (S, Root, T);
- Put (S, ";\npragma \1 (Make_\2);\n\n", Inline, Image_Sans_N (T));
+ Put (S, ";" & LF & "pragma " & Inline & " (Make_" &
+ Image_Sans_N (T) & ");" & LF & LF);
end if;
end loop;
end Put_Make_Decls;
@@ -2472,28 +2473,28 @@ package body Gen_IL.Gen is
-- Put_Make_Bodies --
---------------------
- procedure Put_Make_Bodies (S : in out Sink'Class; Root : Root_Type) is
+ procedure Put_Make_Bodies (S : in out Sink; Root : Root_Type) is
begin
for T in First_Concrete (Root) .. Last_Concrete (Root) loop
if T not in N_Unused_At_Start | N_Unused_At_End then
Put_Make_Spec (S, Root, T);
- Put (S, "\nis\n");
+ Put (S, LF & "is" & LF);
- Indent (S, 3);
- Put (S, "N : constant Node_Id :=\n");
+ Increase_Indent (S, 3);
+ Put (S, "N : constant Node_Id :=" & LF);
if T in Entity_Node then
- Put (S, " New_Entity (\1, Sloc);\n", Image (T));
+ Put (S, " New_Entity (" & Image (T) & ", Sloc);" & LF);
else
- Put (S, " New_Node (\1, Sloc);\n", Image (T));
+ Put (S, " New_Node (" & Image (T) & ", Sloc);" & LF);
end if;
- Outdent (S, 3);
+ Decrease_Indent (S, 3);
- Put (S, "begin\n");
+ Put (S, "begin" & LF);
- Indent (S, 3);
+ Increase_Indent (S, 3);
for F of Type_Table (T).Fields loop
pragma Assert (Fields_Per_Node (T) (F));
@@ -2508,15 +2509,15 @@ package body Gen_IL.Gen is
begin
if F_Name'Length < NWidth then
- Put (S, "Set_\1 (N, \1);\n", F_Name);
+ Put (S, "Set_" & F_Name & " (N, " & F_Name & ");" & LF);
-- Wrap the line
else
- Put (S, "Set_\1\n", F_Name);
- Indent (S, 2);
- Put (S, "(N, \1);\n", F_Name);
- Outdent (S, 2);
+ Put (S, "Set_" & F_Name & "" & LF);
+ Increase_Indent (S, 2);
+ Put (S, "(N, " & F_Name & ");" & LF);
+ Decrease_Indent (S, 2);
end if;
end;
end if;
@@ -2554,15 +2555,15 @@ package body Gen_IL.Gen is
-- "Op_", but the Name_Id constant does not.
begin
- Put (S, "Set_Chars (N, Name_\1);\n", Op_Name);
- Put (S, "Set_Entity (N, Standard_\1);\n", Op);
+ Put (S, "Set_Chars (N, Name_" & Op_Name & ");" & LF);
+ Put (S, "Set_Entity (N, Standard_" & Op & ");" & LF);
end;
end if;
- Put (S, "return N;\n");
- Outdent (S, 3);
+ Put (S, "return N;" & LF);
+ Decrease_Indent (S, 3);
- Put (S, "end Make_\1;\n\n", Image_Sans_N (T));
+ Put (S, "end Make_" & Image_Sans_N (T) & ";" & LF & LF);
end if;
end loop;
end Put_Make_Bodies;
@@ -2593,42 +2594,44 @@ package body Gen_IL.Gen is
-- argument can have side effects (e.g. be a call to a parse routine).
procedure Put_Nmake is
- S : Sink'Class := Create_File ("nmake.ads");
- B : Sink'Class := Create_File ("nmake.adb");
+ S : Sink;
+ B : Sink;
begin
- Put (S, "with Namet; use Namet;\n");
- Put (S, "with Nlists; use Nlists;\n");
- Put (S, "with Types; use Types;\n");
- Put (S, "with Uintp; use Uintp;\n");
- Put (S, "with Urealp; use Urealp;\n");
+ Create_File (S, "nmake.ads");
+ Create_File (B, "nmake.adb");
+ Put (S, "with Namet; use Namet;" & LF);
+ Put (S, "with Nlists; use Nlists;" & LF);
+ Put (S, "with Types; use Types;" & LF);
+ Put (S, "with Uintp; use Uintp;" & LF);
+ Put (S, "with Urealp; use Urealp;" & LF);
- Put (S, "\npackage Nmake is\n\n");
- Indent (S, 3);
+ Put (S, LF & "package Nmake is" & LF & LF);
+ Increase_Indent (S, 3);
- Put (S, "-- This package is automatically generated.\n\n");
- Put (S, "-- See Put_Nmake in gen_il-gen.adb for documentation.\n\n");
+ Put (S, "-- This package is automatically generated." & LF & LF);
+ Put (S, "-- See Put_Nmake in gen_il-gen.adb for documentation." & LF & LF);
Put_Make_Decls (S, Node_Kind);
- Outdent (S, 3);
- Put (S, "end Nmake;\n");
+ Decrease_Indent (S, 3);
+ Put (S, "end Nmake;" & LF);
- Put (B, "with Atree; use Atree;\n");
- Put (B, "with Sinfo.Nodes; use Sinfo.Nodes;\n");
- Put (B, "with Sinfo.Utils; use Sinfo.Utils;\n");
- Put (B, "with Snames; use Snames;\n");
- Put (B, "with Stand; use Stand;\n");
+ Put (B, "with Atree; use Atree;" & LF);
+ Put (B, "with Sinfo.Nodes; use Sinfo.Nodes;" & LF);
+ Put (B, "with Sinfo.Utils; use Sinfo.Utils;" & LF);
+ Put (B, "with Snames; use Snames;" & LF);
+ Put (B, "with Stand; use Stand;" & LF);
- Put (B, "\npackage body Nmake is\n\n");
- Indent (B, 3);
+ Put (B, LF & "package body Nmake is" & LF & LF);
+ Increase_Indent (B, 3);
- Put (B, "-- This package is automatically generated.\n\n");
+ Put (B, "-- This package is automatically generated." & LF & LF);
Put_Make_Bodies (B, Node_Kind);
- Outdent (B, 3);
- Put (B, "end Nmake;\n");
+ Decrease_Indent (B, 3);
+ Put (B, "end Nmake;" & LF);
end Put_Nmake;
-----------------------
@@ -2636,8 +2639,8 @@ package body Gen_IL.Gen is
-----------------------
procedure Put_Seinfo_Tables is
- S : Sink'Class := Create_File ("seinfo_tables.ads");
- B : Sink'Class := Create_File ("seinfo_tables.adb");
+ S : Sink;
+ B : Sink;
Type_Layout : Concrete_Type_Layout_Array;
@@ -2715,15 +2718,17 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (B, ",\n");
+ Put (B, "," & LF);
end if;
- Put (B, "\1", Image (F));
+ Put (B, Image (F));
end if;
end loop;
end Put_Field_List;
begin -- Put_Seinfo_Tables
+ Create_File (S, "seinfo_tables.ads");
+ Create_File (B, "seinfo_tables.adb");
for T in Concrete_Type loop
Type_Layout (T) := new Field_Array'
@@ -2753,50 +2758,50 @@ package body Gen_IL.Gen is
end loop;
end loop;
- Put (S, "\npackage Seinfo_Tables is\n\n");
- Indent (S, 3);
+ Put (S, LF & "package Seinfo_Tables is" & LF & LF);
+ Increase_Indent (S, 3);
- Put (S, "-- This package is automatically generated.\n\n");
+ Put (S, "-- This package is automatically generated." & LF & LF);
- Put (S, "-- This package is not used by the compiler.\n");
- Put (S, "-- The body contains tables that are intended to be used by humans to\n");
- Put (S, "-- help understand the layout of various data structures.\n\n");
+ Put (S, "-- This package is not used by the compiler." & LF);
+ Put (S, "-- The body contains tables that are intended to be used by humans to" & LF);
+ Put (S, "-- help understand the layout of various data structures." & LF & LF);
- Put (S, "pragma Elaborate_Body;\n");
+ Put (S, "pragma Elaborate_Body;" & LF);
- Outdent (S, 3);
- Put (S, "\nend Seinfo_Tables;\n");
+ Decrease_Indent (S, 3);
+ Put (S, LF & "end Seinfo_Tables;" & LF);
- Put (B, "with Gen_IL.Types; use Gen_IL.Types;\n");
- Put (B, "with Gen_IL.Fields; use Gen_IL.Fields;\n");
- Put (B, "with Gen_IL.Internals; use Gen_IL.Internals;\n");
+ Put (B, "with Gen_IL.Types; use Gen_IL.Types;" & LF);
+ Put (B, "with Gen_IL.Fields; use Gen_IL.Fields;" & LF);
+ Put (B, "with Gen_IL.Internals; use Gen_IL.Internals;" & LF);
- Put (B, "\npackage body Seinfo_Tables is\n\n");
- Indent (B, 3);
+ Put (B, LF & "package body Seinfo_Tables is" & LF & LF);
+ Increase_Indent (B, 3);
- Put (B, "-- This package is automatically generated.\n\n");
+ Put (B, "-- This package is automatically generated." & LF & LF);
- Put (B, "Num_Wasted_Bits : Bit_Offset'Base := \1 with Unreferenced;\n",
- Image (Num_Wasted_Bits));
+ Put (B, "Num_Wasted_Bits : Bit_Offset'Base := " & Image (Num_Wasted_Bits) &
+ " with Unreferenced;" & LF);
- Put (B, "\nWasted_Bits : constant Opt_Field_Enum := No_Field;\n");
+ Put (B, LF & "Wasted_Bits : constant Opt_Field_Enum := No_Field;" & LF);
- Put (B, "\n-- Table showing the layout of each Node_Or_Entity_Type. For each\n");
- Put (B, "-- concrete type, we show the bits used by each field. Each field\n");
- Put (B, "-- uses the same bit range in all types. This table is not used by\n");
- Put (B, "-- the compiler; it is for information only.\n\n");
+ Put (B, LF & "-- Table showing the layout of each Node_Or_Entity_Type. For each" & LF);
+ Put (B, "-- concrete type, we show the bits used by each field. Each field" & LF);
+ Put (B, "-- uses the same bit range in all types. This table is not used by" & LF);
+ Put (B, "-- the compiler; it is for information only." & LF & LF);
- Put (B, "-- Wasted_Bits are unused bits between fields, and padding at the end\n");
- Put (B, "-- to round up to a multiple of the slot size.\n");
+ Put (B, "-- Wasted_Bits are unused bits between fields, and padding at the end" & LF);
+ Put (B, "-- to round up to a multiple of the slot size." & LF);
- Put (B, "\n-- Type_Layout is \1 bytes.\n", Image (Type_Layout_Size / 8));
+ Put (B, LF & "-- Type_Layout is " & Image (Type_Layout_Size / 8) & " bytes." & LF);
- Put (B, "\npragma Style_Checks (Off);\n");
- Put (B, "Type_Layout : constant Concrete_Type_Layout_Array := \n");
- Indent (B, 2);
- Put (B, "-- Concrete node types:\n");
+ Put (B, LF & "pragma Style_Checks (Off);" & LF);
+ Put (B, "Type_Layout : constant Concrete_Type_Layout_Array := " & LF);
+ Increase_Indent (B, 2);
+ Put (B, "-- Concrete node types:" & LF);
Put (B, "(");
- Indent (B, 1);
+ Increase_Indent (B, 1);
declare
First_Time : Boolean := True;
@@ -2805,18 +2810,18 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (B, ",\n\n");
+ Put (B, "," & LF & LF);
end if;
if T = Concrete_Entity'First then
- Put (B, "-- Concrete entity types:\n\n");
+ Put (B, "-- Concrete entity types:" & LF & LF);
end if;
- Put (B, "\1 => new Field_Array'\n", Image (T));
+ Put (B, Image (T) & " => new Field_Array'" & LF);
- Indent (B, 2);
+ Increase_Indent (B, 2);
Put (B, "(");
- Indent (B, 1);
+ Increase_Indent (B, 1);
declare
First_Time : Boolean := True;
@@ -2826,7 +2831,7 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (B, ",\n");
+ Put (B, "," & LF);
end if;
declare
@@ -2842,16 +2847,14 @@ package body Gen_IL.Gen is
(First_Bit .. Last_Bit => F));
if Last_Bit = First_Bit then
- Put (B, "\1 => \2",
- First_Bit_Image (First_Bit),
+ Put (B, First_Bit_Image (First_Bit) & " => " &
Image_Or_Waste (F));
else
pragma Assert
(if F /= No_Field then
First_Bit mod Field_Size (F) = 0);
- Put (B, "\1 .. \2 => \3",
- First_Bit_Image (First_Bit),
- Last_Bit_Image (Last_Bit),
+ Put (B, First_Bit_Image (First_Bit) & " .. " &
+ Last_Bit_Image (Last_Bit) & " => " &
Image_Or_Waste (F));
end if;
@@ -2861,25 +2864,25 @@ package body Gen_IL.Gen is
end loop;
end;
- Outdent (B, 1);
+ Decrease_Indent (B, 1);
Put (B, ")");
- Outdent (B, 2);
+ Decrease_Indent (B, 2);
end loop;
end;
- Outdent (B, 1);
- Put (B, ") -- Type_Layout\n");
- Indent (B, 6);
- Put (B, "with Export, Convention => Ada;\n");
- Outdent (B, 6);
- Outdent (B, 2);
+ Decrease_Indent (B, 1);
+ Put (B, ") -- Type_Layout" & LF);
+ Increase_Indent (B, 6);
+ Put (B, "with Export, Convention => Ada;" & LF);
+ Decrease_Indent (B, 6);
+ Decrease_Indent (B, 2);
- Put (B, "\n-- Table mapping bit offsets to the set of fields at that offset\n\n");
- Put (B, "Bit_Used : constant Offset_To_Fields_Mapping :=\n");
+ Put (B, LF & "-- Table mapping bit offsets to the set of fields at that offset" & LF & LF);
+ Put (B, "Bit_Used : constant Offset_To_Fields_Mapping :=" & LF);
- Indent (B, 2);
+ Increase_Indent (B, 2);
Put (B, "(");
- Indent (B, 1);
+ Increase_Indent (B, 1);
declare
First_Time : Boolean := True;
@@ -2890,33 +2893,33 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (B, ",\n\n");
+ Put (B, "," & LF & LF);
end if;
- Put (B, "\1 => new Field_Array'\n", First_Bit_Image (Bit));
+ Put (B, First_Bit_Image (Bit) & " => new Field_Array'" & LF);
-- Use [...] notation here, to get around annoying Ada
-- limitations on empty and singleton aggregates. This code is
-- not used in the compiler, so there are no bootstrap issues.
- Indent (B, 2);
+ Increase_Indent (B, 2);
Put (B, "[");
- Indent (B, 1);
+ Increase_Indent (B, 1);
Put_Field_List (Bit);
- Outdent (B, 1);
+ Decrease_Indent (B, 1);
Put (B, "]");
- Outdent (B, 2);
+ Decrease_Indent (B, 2);
end loop;
end;
- Outdent (B, 1);
- Put (B, "); -- Bit_Used\n");
- Outdent (B, 2);
+ Decrease_Indent (B, 1);
+ Put (B, "); -- Bit_Used" & LF);
+ Decrease_Indent (B, 2);
- Outdent (B, 3);
- Put (B, "\nend Seinfo_Tables;\n");
+ Decrease_Indent (B, 3);
+ Put (B, LF & "end Seinfo_Tables;" & LF);
end Put_Seinfo_Tables;
@@ -2925,7 +2928,7 @@ package body Gen_IL.Gen is
-----------------------------
procedure Put_C_Type_And_Subtypes
- (S : in out Sink'Class; Root : Root_Type) is
+ (S : in out Sink; Root : Root_Type) is
procedure Put_Enum_Lit (T : Node_Or_Entity_Type);
-- Print out the #define corresponding to the Ada enumeration literal
@@ -2938,37 +2941,29 @@ package body Gen_IL.Gen is
procedure Put_Enum_Lit (T : Node_Or_Entity_Type) is
begin
if T in Concrete_Type then
- Put (S, "#define \1 \2\n", Image (T), Image (Pos (T)));
+ Put (S, "#define " & Image (T) & " " & Image (Pos (T)) & "" & LF);
end if;
end Put_Enum_Lit;
procedure Put_Kind_Subtype (T : Node_Or_Entity_Type) is
begin
if T in Abstract_Type and then Type_Table (T).Parent /= No_Type then
- Put (S, "SUBTYPE (\1, \2,\n",
- Image (T),
- Image (Type_Table (T).Parent));
- Indent (S, 3);
- Put (S, "\1,\n\2)\n",
- Image (Type_Table (T).First),
- Image (Type_Table (T).Last));
- Outdent (S, 3);
+ Put (S, "SUBTYPE (" & Image (T) & ", " &
+ Image (Type_Table (T).Parent) & "," & LF);
+ Increase_Indent (S, 3);
+ Put (S, Image (Type_Table (T).First) & "," & LF);
+ Put (S, Image (Type_Table (T).Last) & ")" & LF);
+ Decrease_Indent (S, 3);
end if;
end Put_Kind_Subtype;
begin
- Indent (S, 6);
Iterate_Types (Root, Pre => Put_Enum_Lit'Access);
- Put (S, "\n#define Number_\1_Kinds \2\n",
- Node_Or_Entity (Root),
- Image (Pos (Last_Concrete (Root)) + 1));
+ Put (S, "#define Number_" & Node_Or_Entity (Root) & "_Kinds " &
+ Image (Pos (Last_Concrete (Root)) + 1) & "" & LF & LF);
- Outdent (S, 6);
-
- Indent (S, 3);
Iterate_Types (Root, Pre => Put_Kind_Subtype'Access);
- Outdent (S, 3);
Put_Union_Membership (S, Root);
end Put_C_Type_And_Subtypes;
@@ -2978,17 +2973,15 @@ package body Gen_IL.Gen is
----------------------------
procedure Put_Low_Level_C_Getter
- (S : in out Sink'Class; T : Type_Enum)
+ (S : in out Sink; T : Type_Enum)
is
T_Image : constant String := Get_Set_Id_Image (T);
begin
- Put (S, "static \1 Get_\2(Node_Id N, Field_Offset Offset);\n\n",
- T_Image, Image (T));
- Put (S, "INLINE \1\n", T_Image);
- Put (S, "Get_\1(Node_Id N, Field_Offset Offset)\n", Image (T));
+ Put (S, "INLINE " & T_Image & "" & LF);
+ Put (S, "Get_" & Image (T) & " (Node_Id N, Field_Offset Offset)" & LF);
- Indent (S, 3);
+ Increase_Indent (S, 3);
-- Same special case as in Put_Low_Level_Accessor_Instantiations
@@ -3000,16 +2993,17 @@ package body Gen_IL.Gen is
(if T = Elist_Id then "No_Elist" else "Uint_0");
begin
- Put (S, "{ return (\1) Get_32_Bit_Field_With_Default(N, Offset, \2); }\n\n",
- T_Image, Default_Val);
+ Put (S, "{ return (" & T_Image &
+ ") Get_32_Bit_Field_With_Default(N, Offset, " &
+ Default_Val & "); }" & LF & LF);
end;
else
- Put (S, "{ return (\1) Get_\2_Bit_Field(N, Offset); }\n\n",
- T_Image, Image (Field_Size (T)));
+ Put (S, "{ return (" & T_Image & ") Get_" &
+ Image (Field_Size (T)) & "_Bit_Field(N, Offset); }" & LF & LF);
end if;
- Outdent (S, 3);
+ Decrease_Indent (S, 3);
end Put_Low_Level_C_Getter;
-----------------------------
@@ -3017,19 +3011,18 @@ package body Gen_IL.Gen is
-----------------------------
procedure Put_High_Level_C_Getter
- (S : in out Sink'Class; F : Field_Enum)
+ (S : in out Sink; F : Field_Enum)
is
begin
- Put (S, "INLINE \1 \2\n",
- Get_Set_Id_Image (Field_Table (F).Field_Type), Image (F));
- Put (S, "(Node_Id N)\n");
-
- Indent (S, 3);
- Put (S, "{ return \1(\2, \3); }\n\n",
- Low_Level_Getter_Name (Field_Table (F).Field_Type),
- Node_To_Fetch_From (F),
- Image (Field_Table (F).Offset));
- Outdent (S, 3);
+ Put (S, "INLINE " & Get_Set_Id_Image (Field_Table (F).Field_Type) &
+ " " & Image (F) & " (Node_Id N)" & LF);
+
+ Increase_Indent (S, 3);
+ Put (S, "{ return " &
+ Low_Level_Getter_Name (Field_Table (F).Field_Type) &
+ "(" & Node_To_Fetch_From (F) & ", " &
+ Image (Field_Table (F).Offset) & "); }" & LF & LF);
+ Decrease_Indent (S, 3);
end Put_High_Level_C_Getter;
------------------------------
@@ -3037,10 +3030,10 @@ package body Gen_IL.Gen is
------------------------------
procedure Put_High_Level_C_Getters
- (S : in out Sink'Class; Root : Root_Type)
+ (S : in out Sink; Root : Root_Type)
is
begin
- Put (S, "// Getters for fields\n\n");
+ Put (S, "// Getters for fields" & LF & LF);
for F in First_Field (Root) .. Last_Field (Root) loop
Put_High_Level_C_Getter (S, F);
@@ -3052,7 +3045,7 @@ package body Gen_IL.Gen is
--------------------------
procedure Put_Union_Membership
- (S : in out Sink'Class; Root : Root_Type) is
+ (S : in out Sink; Root : Root_Type) is
procedure Put_Ors (T : Abstract_Type);
-- Print the "or" (i.e. "||") of tests whether kind is in each child
@@ -3065,7 +3058,7 @@ package body Gen_IL.Gen is
if First_Time then
First_Time := False;
else
- Put (S, " ||\n");
+ Put (S, " ||" & LF);
end if;
-- Unions, other abstract types, and concrete types each have
@@ -3073,39 +3066,37 @@ package body Gen_IL.Gen is
if Child in Abstract_Type then
if Type_Table (Child).Is_Union then
- Put (S, "Is_In_\1 (kind)", Image (Child));
+ Put (S, "Is_In_" & Image (Child) & " (kind)");
else
- Put (S, "IN (kind, \1)", Image (Child));
+ Put (S, "IN (kind, " & Image (Child) & ")");
end if;
else
- Put (S, "kind == \1", Image (Child));
+ Put (S, "kind == " & Image (Child));
end if;
end loop;
end Put_Ors;
begin
- Put (S, "\n// Membership tests for union types\n\n");
+ Put (S, LF & "// Membership tests for union types" & LF & LF);
for T in First_Abstract (Root) .. Last_Abstract (Root) loop
if Type_Table (T) /= null and then Type_Table (T).Is_Union then
- Put (S, "static Boolean Is_In_\1(\2_Kind kind);\n",
- Image (T), Node_Or_Entity (Root));
- Put (S, "INLINE Boolean\n");
- Put (S, "Is_In_\1(\2_Kind kind)\n",
- Image (T), Node_Or_Entity (Root));
-
- Put (S, "{\n");
- Indent (S, 3);
- Put (S, "return\n");
- Indent (S, 3);
+ Put (S, "INLINE Boolean" & LF);
+ Put (S, "Is_In_" & Image (T) & " (" &
+ Node_Or_Entity (Root) & "_Kind kind)" & LF);
+
+ Put (S, "{" & LF);
+ Increase_Indent (S, 3);
+ Put (S, "return" & LF);
+ Increase_Indent (S, 3);
Put_Ors (T);
- Outdent (S, 3);
- Outdent (S, 3);
- Put (S, ";\n}\n");
+ Decrease_Indent (S, 3);
+ Decrease_Indent (S, 3);
+ Put (S, ";" & LF & "}" & LF);
- Put (S, "\n");
+ Put (S, "" & LF);
end if;
end loop;
end Put_Union_Membership;
@@ -3115,19 +3106,20 @@ package body Gen_IL.Gen is
---------------------
procedure Put_Sinfo_Dot_H is
- S : Sink'Class := Create_File ("sinfo.h");
+ S : Sink;
begin
- Put (S, "#ifdef __cplusplus\n");
- Put (S, "extern ""C"" {\n");
- Put (S, "#endif\n\n");
+ Create_File (S, "sinfo.h");
+ Put (S, "#ifdef __cplusplus" & LF);
+ Put (S, "extern ""C"" {" & LF);
+ Put (S, "#endif" & LF & LF);
- Put (S, "typedef Boolean Flag;\n\n");
+ Put (S, "typedef Boolean Flag;" & LF & LF);
Put_C_Type_And_Subtypes (S, Node_Kind);
- Put (S, "\n// Getters corresponding to instantiations of Atree.Get_n_Bit_Field\n");
- Put (S, "// generic functions.\n\n");
+ Put (S, "// Getters corresponding to instantiations of Atree.Get_n_Bit_Field"
+ & LF & LF);
for T in Special_Type loop
Put_Low_Level_C_Getter (S, T);
@@ -3135,9 +3127,9 @@ package body Gen_IL.Gen is
Put_High_Level_C_Getters (S, Node_Kind);
- Put (S, "#ifdef __cplusplus\n");
- Put (S, "}\n");
- Put (S, "#endif\n");
+ Put (S, "#ifdef __cplusplus" & LF);
+ Put (S, "}" & LF);
+ Put (S, "#endif" & LF);
end Put_Sinfo_Dot_H;
---------------------
@@ -3145,10 +3137,9 @@ package body Gen_IL.Gen is
---------------------
procedure Put_Einfo_Dot_H is
- S : Sink'Class := Create_File ("einfo.h");
+ S : Sink;
procedure Put_Membership_Query_Spec (T : Node_Or_Entity_Type);
- procedure Put_Membership_Query_Decl (T : Node_Or_Entity_Type);
procedure Put_Membership_Query_Defn (T : Node_Or_Entity_Type);
-- Print out the Is_... function for T that calls the IN macro on the
-- SUBTYPE.
@@ -3165,59 +3156,43 @@ package body Gen_IL.Gen is
begin
pragma Assert (not Type_Table (T).Is_Union);
- Put (S, "INLINE B Is_\1\2 ", Im2, Typ);
- Tab_To_Column (S, 49);
- Put (S, "(E Id)");
+ Put (S, "INLINE B Is_" & Im2 & Typ & " (E Id)");
end Put_Membership_Query_Spec;
- procedure Put_Membership_Query_Decl (T : Node_Or_Entity_Type) is
- begin
- if T in Abstract_Type and T not in Root_Type then
- Put_Membership_Query_Spec (T);
- Put (S, ";\n");
- end if;
- end Put_Membership_Query_Decl;
-
procedure Put_Membership_Query_Defn (T : Node_Or_Entity_Type) is
begin
if T in Abstract_Type and T not in Root_Type then
Put_Membership_Query_Spec (T);
- Put (S, "\n");
- Indent (S, 3);
- Put (S, "{ return IN (Ekind (Id), \1); }\n", Image (T));
- Outdent (S, 3);
+ Put (S, "" & LF);
+ Increase_Indent (S, 3);
+ Put (S, "{ return IN (Ekind (Id), " & Image (T) & "); }" & LF);
+ Decrease_Indent (S, 3);
end if;
end Put_Membership_Query_Defn;
begin
- Put (S, "#ifdef __cplusplus\n");
- Put (S, "extern ""C"" {\n");
- Put (S, "#endif\n\n");
+ Create_File (S, "einfo.h");
+ Put (S, "#ifdef __cplusplus" & LF);
+ Put (S, "extern ""C"" {" & LF);
+ Put (S, "#endif" & LF & LF);
- Put (S, "typedef Boolean Flag;\n\n");
+ Put (S, "typedef Boolean Flag;" & LF & LF);
Put_C_Type_And_Subtypes (S, Entity_Kind);
- Put (S, "\n// Getters corresponding to instantiations of Atree.Get_n_Bit_Field\n");
- Put (S, "// generic functions.\n\n");
-
-- Note that we do not call Put_Low_Level_C_Getter here. Those are in
-- sinfo.h, so every file that #includes einfo.h must #include
-- sinfo.h first.
Put_High_Level_C_Getters (S, Entity_Kind);
- Put (S, "\n// Abstract type queries\n\n");
+ Put (S, "// Abstract type queries" & LF & LF);
- Indent (S, 3);
- Iterate_Types (Entity_Kind, Pre => Put_Membership_Query_Decl'Access);
- Put (S, "\n");
Iterate_Types (Entity_Kind, Pre => Put_Membership_Query_Defn'Access);
- Outdent (S, 3);
- Put (S, "#ifdef __cplusplus\n");
- Put (S, "}\n");
- Put (S, "#endif\n");
+ Put (S, LF & "#ifdef __cplusplus" & LF);
+ Put (S, "}" & LF);
+ Put (S, "#endif" & LF);
end Put_Einfo_Dot_H;
begin -- Compile
diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb
index d676d91e900..59a142d47a6 100644
--- a/gcc/ada/gen_il-internals.adb
+++ b/gcc/ada/gen_il-internals.adb
@@ -207,44 +207,44 @@ package body Gen_IL.Internals is
-- Put_Types_With_Bars --
-------------------------
- procedure Put_Types_With_Bars (S : in out Sink'Class; U : Type_Vector) is
+ procedure Put_Types_With_Bars (S : in out Sink; U : Type_Vector) is
First_Time : Boolean := True;
begin
- Indent (S, 3);
+ Increase_Indent (S, 3);
for T of U loop
if First_Time then
First_Time := False;
else
- Put (S, "\n| ");
+ Put (S, LF & "| ");
end if;
- Put (S, "\1", Image (T));
+ Put (S, Image (T));
end loop;
- Outdent (S, 3);
+ Decrease_Indent (S, 3);
end Put_Types_With_Bars;
----------------------------
-- Put_Type_Ids_With_Bars --
----------------------------
- procedure Put_Type_Ids_With_Bars (S : in out Sink'Class; U : Type_Vector) is
+ procedure Put_Type_Ids_With_Bars (S : in out Sink; U : Type_Vector) is
First_Time : Boolean := True;
begin
- Indent (S, 3);
+ Increase_Indent (S, 3);
for T of U loop
if First_Time then
First_Time := False;
else
- Put (S, "\n| ");
+ Put (S, LF & "| ");
end if;
- Put (S, "\1", Id_Image (T));
+ Put (S, Id_Image (T));
end loop;
- Outdent (S, 3);
+ Decrease_Indent (S, 3);
end Put_Type_Ids_With_Bars;
-----------
@@ -431,7 +431,7 @@ package body Gen_IL.Internals is
-- Put_Type_Hierarchy --
------------------------
- procedure Put_Type_Hierarchy (S : in out Sink'Class; Root : Root_Type) is
+ procedure Put_Type_Hierarchy (S : in out Sink; Root : Root_Type) is
Level : Natural := 0;
function Indentation return String is ((1 .. 3 * Level => ' '));
@@ -444,7 +444,7 @@ package body Gen_IL.Internals is
procedure Pre (T : Node_Or_Entity_Type) is
begin
- Put (S, "-- \1\2\n", Indentation, Image (T));
+ Put (S, "-- " & Indentation & Image (T) & LF);
Level := Level + 1;
end Pre;
@@ -456,7 +456,7 @@ package body Gen_IL.Internals is
-- an arbitrary definition of "many".
if Num_Concrete_Descendants (T) > 10 then
- Put (S, "-- \1end \2\n", Indentation, Image (T));
+ Put (S, "-- " & Indentation & "end " & Image (T) & LF);
end if;
end Post;
@@ -468,13 +468,13 @@ package body Gen_IL.Internals is
-- Start of processing for Put_Type_Hierarchy
begin
- Put (S, "-- Type hierarchy for \1\n", N_Or_E);
- Put (S, "--\n");
+ Put (S, "-- Type hierarchy for " & N_Or_E & LF);
+ Put (S, "--" & LF);
Iterate_Types (Root, Pre'Access, Post'Access);
- Put (S, "--\n");
- Put (S, "-- End type hierarchy for \1\n\n", N_Or_E);
+ Put (S, "--" & LF);
+ Put (S, "-- End type hierarchy for " & N_Or_E & LF & LF);
end Put_Type_Hierarchy;
---------
@@ -489,27 +489,4 @@ package body Gen_IL.Internals is
return Type_Enum'Pos (T) - Type_Enum'Pos (First);
end Pos;
- Stdout : Sink'Class renames Files.Standard_Output.all;
-
- -- The following procedures are for use in gdb. They use the 'Put_Image
- -- attribute. That is commented out, because we don't want this new feature
- -- used in the compiler. If you need this for debugging, just uncomment
- -- those lines back in, and rebuild.
-
- pragma Warnings (Off);
- procedure Ptypes (V : Type_Vector) is
- begin
--- Type_Vector'Put_Image (Stdout, V);
- New_Line (Stdout);
- Flush (Stdout);
- end Ptypes;
-
- procedure Pfields (V : Field_Vector) is
- begin
--- Field_Vector'Put_Image (Stdout, V);
- New_Line (Stdout);
- Flush (Stdout);
- end Pfields;
- pragma Warnings (On);
-
end Gen_IL.Internals;
diff --git a/gcc/ada/gen_il-internals.ads b/gcc/ada/gen_il-internals.ads
index 27022a079f9..8d13e806bda 100644
--- a/gcc/ada/gen_il-internals.ads
+++ b/gcc/ada/gen_il-internals.ads
@@ -47,14 +47,12 @@ package Gen_IL.Internals is
use Type_Vectors;
subtype Type_Vector is Type_Vectors.Vector;
- procedure Ptypes (V : Type_Vector); -- for debugging
-
type Type_Array is array (Type_Index range <>) of Type_Enum;
----------------
- procedure Put_Types_With_Bars (S : in out Sink'Class; U : Type_Vector);
- procedure Put_Type_Ids_With_Bars (S : in out Sink'Class; U : Type_Vector);
+ procedure Put_Types_With_Bars (S : in out Sink; U : Type_Vector);
+ procedure Put_Type_Ids_With_Bars (S : in out Sink; U : Type_Vector);
-- Put the types with vertical bars in between, as in
-- N_This | N_That | N_Other
-- or
@@ -76,7 +74,6 @@ package Gen_IL.Internals is
type Field_Index is new Positive;
package Field_Vectors is new Vectors (Field_Index, Field_Enum);
subtype Field_Vector is Field_Vectors.Vector;
- procedure Pfields (V : Field_Vector); -- for debugging
type Bit_Offset is new Root_Nat range 0 .. 32_000 - 1;
-- Offset in bits. The number 32_000 is chosen because there are fewer than
@@ -213,7 +210,7 @@ package Gen_IL.Internals is
-- True if Ancestor is an ancestor of Descendant. True for
-- a type itself.
- procedure Put_Type_Hierarchy (S : in out Sink'Class; Root : Root_Type);
+ procedure Put_Type_Hierarchy (S : in out Sink; Root : Root_Type);
function Pos (T : Concrete_Type) return Root_Nat;
-- Return Node_Kind'Pos (T) or Entity_Kind'Pos (T)
diff --git a/gcc/ada/gen_il.adb b/gcc/ada/gen_il.adb
index 7114c7c6c2e..23619b63ebb 100644
--- a/gcc/ada/gen_il.adb
+++ b/gcc/ada/gen_il.adb
@@ -23,8 +23,13 @@
-- --
------------------------------------------------------------------------------
+with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
+
package body Gen_IL is
+ procedure Put (F : File_Type; S : String);
+ -- The output primitive
+
-----------
-- Image --
-----------
@@ -72,4 +77,72 @@ package body Gen_IL is
end return;
end Capitalize;
+ -----------------
+ -- Create_File --
+ -----------------
+
+ procedure Create_File (Buffer : in out Sink; Name : String) is
+ begin
+ Create (Buffer.File, Out_File, Name);
+ Buffer.Indent := 0;
+ Buffer.New_Line := True;
+ end Create_File;
+
+ ---------------------
+ -- Increase_Indent --
+ ---------------------
+
+ procedure Increase_Indent (Buffer : in out Sink; Amount : Natural) is
+ begin
+ Buffer.Indent := Buffer.Indent + Amount;
+ end Increase_Indent;
+
+ ---------------------
+ -- Decrease_Indent --
+ ---------------------
+
+ procedure Decrease_Indent (Buffer : in out Sink; Amount : Natural) is
+ begin
+ Buffer.Indent := Buffer.Indent - Amount;
+ end Decrease_Indent;
+
+ ---------
+ -- Put --
+ ---------
+
+ procedure Put (F : File_Type; S : String) is
+ begin
+ String'Write (Stream (F), S);
+ end Put;
+
+ procedure Put (Buffer : in out Sink; Item : String) is
+ begin
+ -- If the first character is LF, indent after it only
+
+ if Item (Item'First) = ASCII.LF then
+ Put (Buffer.File, LF);
+ Buffer.New_Line := True;
+
+ if Item'Length > 1 then
+ Put (Buffer, Item (Item'First + 1 .. Item'Last));
+ end if;
+
+ return;
+ end if;
+
+ -- If this is a new line, indent
+
+ if Buffer.New_Line and then Buffer.Indent > 0 then
+ declare
+ S : constant String (1 .. Buffer.Indent) := (others => ' ');
+ begin
+ Put (Buffer.File, S);
+ end;
+ end if;
+
+ Put (Buffer.File, Item);
+
+ Buffer.New_Line := Item (Item'Last) = ASCII.LF;
+ end Put;
+
end Gen_IL;
diff --git a/gcc/ada/gen_il.ads b/gcc/ada/gen_il.ads
index 6a86ed6d610..5f307fe7c50 100644
--- a/gcc/ada/gen_il.ads
+++ b/gcc/ada/gen_il.ads
@@ -24,11 +24,8 @@
------------------------------------------------------------------------------
pragma Warnings (Off); -- with clauses for children
-with Ada.Strings.Text_Output.Formatting;
-use Ada.Strings.Text_Output, Ada.Strings.Text_Output.Formatting;
-with Ada.Strings.Text_Output.Files; use Ada.Strings.Text_Output.Files;
-with Ada.Strings.Text_Output.Utils; use Ada.Strings.Text_Output.Utils;
-with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Streams.Stream_IO;
pragma Warnings (On);
package Gen_IL is -- generate intermediate language
@@ -76,4 +73,24 @@ package Gen_IL is -- generate intermediate language
procedure Capitalize (S : in out String);
-- Turns an identifier into Mixed_Case
+ -- The following declares a minimal implementation of formatted output
+ -- that is piggybacked on Ada.Streams.Stream_IO for bootstrap reasons.
+ -- It uses LF as universal line terminator to make it host independent.
+
+ type Sink is record
+ File : Ada.Streams.Stream_IO.File_Type;
+ Indent : Natural;
+ New_Line : Boolean;
+ end record;
+
+ procedure Create_File (Buffer : in out Sink; Name : String);
+
+ procedure Increase_Indent (Buffer : in out Sink; Amount : Natural);
+
+ procedure Decrease_Indent (Buffer : in out Sink; Amount : Natural);
+
+ procedure Put (Buffer : in out Sink; Item : String);
+
+ LF : constant String := "" & ASCII.LF;
+
end Gen_IL;
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index 75b50467a0a..7e4a4d9cd76 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -632,16 +632,26 @@ package body Impunit is
("s-aotase", T), -- System.Atomic_Operations.Test_And_Set
("s-atoope", T), -- System.Atomic_Operations
("s-atopex", T), -- System.Atomic_Operations.Exchange
+ ("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-stoubu", T), -- Ada.Strings.Text_Output.Buffers
("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
+ ("a-ststun", T), -- Ada.Streams.Storage.Unbounded
+
+ ----------------------------------------
+ -- GNAT Defined Additions to Ada 2022 --
+ ----------------------------------------
+
+ ("a-stbufi", T), -- Ada.Strings.Text_Buffers.Files
+ ("a-stbufo", T), -- Ada.Strings.Text_Buffers.Formatting
+ ("a-stbuut", T) -- Ada.Strings.Text_Buffers.Utils
);
-----------------------
diff --git a/gcc/ada/libgnarl/s-putaim.adb b/gcc/ada/libgnarl/s-putaim.adb
index ae785e2f83e..687ac0e7815 100644
--- a/gcc/ada/libgnarl/s-putaim.adb
+++ b/gcc/ada/libgnarl/s-putaim.adb
@@ -29,13 +29,10 @@
-- --
------------------------------------------------------------------------------
-with Unchecked_Conversion;
-with Ada.Strings.Text_Output.Utils;
-use Ada.Strings.Text_Output;
-use Ada.Strings.Text_Output.Utils;
-
package body System.Put_Task_Images is
+ use Ada.Strings.Text_Buffers;
+
procedure Put_Image_Protected (S : in out Sink'Class) is
begin
Put_UTF_8 (S, "(protected object)");
diff --git a/gcc/ada/libgnarl/s-putaim.ads b/gcc/ada/libgnarl/s-putaim.ads
index 5ad69dbdc95..ff0c34468df 100644
--- a/gcc/ada/libgnarl/s-putaim.ads
+++ b/gcc/ada/libgnarl/s-putaim.ads
@@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Text_Output;
+with Ada.Strings.Text_Buffers;
with Ada.Task_Identification;
package System.Put_Task_Images is
@@ -39,7 +39,7 @@ package System.Put_Task_Images is
-- separate from System.Put_Images to avoid dragging the tasking runtimes
-- into nontasking programs.
- subtype Sink is Ada.Strings.Text_Output.Sink;
+ subtype Sink is Ada.Strings.Text_Buffers.Root_Buffer_Type;
procedure Put_Image_Protected (S : in out Sink'Class);
procedure Put_Image_Task
diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb
index 0d29cfd28f6..bb92bda9ebb 100644
--- a/gcc/ada/libgnat/a-cbdlli.adb
+++ b/gcc/ada/libgnat/a-cbdlli.adb
@@ -1504,7 +1504,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : List)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : List)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads
index 8773e213284..ab55086e687 100644
--- a/gcc/ada/libgnat/a-cbdlli.ads
+++ b/gcc/ada/libgnat/a-cbdlli.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -285,7 +285,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : List);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : List);
procedure Read
(Stream : not null access Root_Stream_Type'Class;
diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb
index 6d490adc4cd..78a590f7586 100644
--- a/gcc/ada/libgnat/a-cbhama.adb
+++ b/gcc/ada/libgnat/a-cbhama.adb
@@ -902,7 +902,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads
index 482b5fde730..8be64c82fa4 100644
--- a/gcc/ada/libgnat/a-cbhama.ads
+++ b/gcc/ada/libgnat/a-cbhama.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
private with Ada.Streams;
private with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Key_Type is private;
@@ -349,7 +349,7 @@ private
with null record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map);
use HT_Types, HT_Types.Implementation;
use Ada.Streams;
diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb
index c87d2ac68d4..f8ca4d2720b 100644
--- a/gcc/ada/libgnat/a-cbhase.adb
+++ b/gcc/ada/libgnat/a-cbhase.adb
@@ -1125,7 +1125,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads
index 90d7ff9281e..92926c13014 100644
--- a/gcc/ada/libgnat/a-cbhase.ads
+++ b/gcc/ada/libgnat/a-cbhase.ads
@@ -37,7 +37,7 @@ private with Ada.Containers.Hash_Tables;
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -507,7 +507,7 @@ private
with null record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
use HT_Types, HT_Types.Implementation;
use Ada.Streams;
diff --git a/gcc/ada/libgnat/a-cbmutr.adb b/gcc/ada/libgnat/a-cbmutr.adb
index 25524d0fe74..714dea1a3ee 100644
--- a/gcc/ada/libgnat/a-cbmutr.adb
+++ b/gcc/ada/libgnat/a-cbmutr.adb
@@ -2328,7 +2328,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Tree)
is
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cbmutr.ads b/gcc/ada/libgnat/a-cbmutr.ads
index 3a519c80bf3..c7e221af262 100644
--- a/gcc/ada/libgnat/a-cbmutr.ads
+++ b/gcc/ada/libgnat/a-cbmutr.ads
@@ -35,7 +35,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -311,7 +311,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Tree);
procedure Write
(Stream : not null access Root_Stream_Type'Class;
diff --git a/gcc/ada/libgnat/a-cborma.adb b/gcc/ada/libgnat/a-cborma.adb
index 186aad7f45b..67e610847b2 100644
--- a/gcc/ada/libgnat/a-cborma.adb
+++ b/gcc/ada/libgnat/a-cborma.adb
@@ -1306,7 +1306,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cborma.ads b/gcc/ada/libgnat/a-cborma.ads
index 1b41ce903d6..f87522a3c67 100644
--- a/gcc/ada/libgnat/a-cborma.ads
+++ b/gcc/ada/libgnat/a-cborma.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Streams;
private with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Key_Type is private;
@@ -257,7 +257,7 @@ private
with null record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map);
use Red_Black_Trees;
use Tree_Types, Tree_Types.Implementation;
diff --git a/gcc/ada/libgnat/a-cborse.adb b/gcc/ada/libgnat/a-cborse.adb
index 54cb7ce0705..0b9e0cc6b9a 100644
--- a/gcc/ada/libgnat/a-cborse.adb
+++ b/gcc/ada/libgnat/a-cborse.adb
@@ -1645,7 +1645,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads
index a79bb7d0073..06bd20f7b9d 100644
--- a/gcc/ada/libgnat/a-cborse.ads
+++ b/gcc/ada/libgnat/a-cborse.ads
@@ -37,7 +37,7 @@ with Ada.Containers.Helpers;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Streams;
private with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -345,7 +345,7 @@ private
with null record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
use Tree_Types, Tree_Types.Implementation;
use Ada.Finalization;
diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb
index 3b82ac51b90..73c1e6d7827 100644
--- a/gcc/ada/libgnat/a-cdlili.adb
+++ b/gcc/ada/libgnat/a-cdlili.adb
@@ -1269,7 +1269,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : List)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : List)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cdlili.ads b/gcc/ada/libgnat/a-cdlili.ads
index 8d2d345b066..66368b544c9 100644
--- a/gcc/ada/libgnat/a-cdlili.ads
+++ b/gcc/ada/libgnat/a-cdlili.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -288,7 +288,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : List);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : List);
overriding procedure Adjust (Container : in out List);
diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb
index 58170fe73f0..3fc57da552e 100644
--- a/gcc/ada/libgnat/a-cidlli.adb
+++ b/gcc/ada/libgnat/a-cidlli.adb
@@ -1311,7 +1311,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : List)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : List)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cidlli.ads b/gcc/ada/libgnat/a-cidlli.ads
index d5c4e45e32b..c8794a3d8c5 100644
--- a/gcc/ada/libgnat/a-cidlli.ads
+++ b/gcc/ada/libgnat/a-cidlli.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type (<>) is private;
@@ -282,7 +282,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : List);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : List);
overriding procedure Adjust (Container : in out List);
diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb
index 0bc4473eb7f..2fbf65e4e29 100644
--- a/gcc/ada/libgnat/a-cihama.adb
+++ b/gcc/ada/libgnat/a-cihama.adb
@@ -973,7 +973,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads
index 1f0173d6615..056f338b8a8 100644
--- a/gcc/ada/libgnat/a-cihama.ads
+++ b/gcc/ada/libgnat/a-cihama.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Key_Type (<>) is private;
@@ -336,7 +336,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb
index d3876fce4cd..9fd4d985c79 100644
--- a/gcc/ada/libgnat/a-cihase.adb
+++ b/gcc/ada/libgnat/a-cihase.adb
@@ -1281,7 +1281,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cihase.ads b/gcc/ada/libgnat/a-cihase.ads
index 3547fca27d2..a73e8982590 100644
--- a/gcc/ada/libgnat/a-cihase.ads
+++ b/gcc/ada/libgnat/a-cihase.ads
@@ -37,7 +37,7 @@ private with Ada.Containers.Hash_Tables;
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type (<>) is private;
@@ -500,7 +500,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
diff --git a/gcc/ada/libgnat/a-cimutr.adb b/gcc/ada/libgnat/a-cimutr.adb
index f5cba6e8517..aa7efac0d4f 100644
--- a/gcc/ada/libgnat/a-cimutr.adb
+++ b/gcc/ada/libgnat/a-cimutr.adb
@@ -1881,7 +1881,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Tree)
is
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cimutr.ads b/gcc/ada/libgnat/a-cimutr.ads
index 2ac562727b0..014d1fe5b07 100644
--- a/gcc/ada/libgnat/a-cimutr.ads
+++ b/gcc/ada/libgnat/a-cimutr.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type (<>) is private;
@@ -352,7 +352,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Tree);
overriding procedure Adjust (Container : in out Tree);
diff --git a/gcc/ada/libgnat/a-ciorma.adb b/gcc/ada/libgnat/a-ciorma.adb
index b53cbcb5df8..a5691563802 100644
--- a/gcc/ada/libgnat/a-ciorma.adb
+++ b/gcc/ada/libgnat/a-ciorma.adb
@@ -1297,7 +1297,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-ciorma.ads b/gcc/ada/libgnat/a-ciorma.ads
index 68e9b93c035..157714def83 100644
--- a/gcc/ada/libgnat/a-ciorma.ads
+++ b/gcc/ada/libgnat/a-ciorma.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Key_Type (<>) is private;
@@ -265,7 +265,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
diff --git a/gcc/ada/libgnat/a-ciormu.adb b/gcc/ada/libgnat/a-ciormu.adb
index 0dc1b48007b..f1b9021809e 100644
--- a/gcc/ada/libgnat/a-ciormu.adb
+++ b/gcc/ada/libgnat/a-ciormu.adb
@@ -1663,7 +1663,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-ciormu.ads b/gcc/ada/libgnat/a-ciormu.ads
index 77eb54dad77..cf8ea0df49b 100644
--- a/gcc/ada/libgnat/a-ciormu.ads
+++ b/gcc/ada/libgnat/a-ciormu.ads
@@ -35,7 +35,7 @@
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
with Ada.Iterator_Interfaces;
generic
@@ -472,7 +472,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
diff --git a/gcc/ada/libgnat/a-ciorse.adb b/gcc/ada/libgnat/a-ciorse.adb
index 267daabe452..7e63f15c3ff 100644
--- a/gcc/ada/libgnat/a-ciorse.adb
+++ b/gcc/ada/libgnat/a-ciorse.adb
@@ -1728,7 +1728,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-ciorse.ads b/gcc/ada/libgnat/a-ciorse.ads
index 0e98298f3c4..1a9d82caa3f 100644
--- a/gcc/ada/libgnat/a-ciorse.ads
+++ b/gcc/ada/libgnat/a-ciorse.ads
@@ -37,7 +37,7 @@ with Ada.Containers.Helpers;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type (<>) is private;
@@ -364,7 +364,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
diff --git a/gcc/ada/libgnat/a-coboho.adb b/gcc/ada/libgnat/a-coboho.adb
index ae167e3c5a4..32346d04566 100644
--- a/gcc/ada/libgnat/a-coboho.adb
+++ b/gcc/ada/libgnat/a-coboho.adb
@@ -70,7 +70,7 @@ package body Ada.Containers.Bounded_Holders is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder)
is
use System.Put_Images;
begin
diff --git a/gcc/ada/libgnat/a-coboho.ads b/gcc/ada/libgnat/a-coboho.ads
index 134e58f2279..9dd73baed92 100644
--- a/gcc/ada/libgnat/a-coboho.ads
+++ b/gcc/ada/libgnat/a-coboho.ads
@@ -30,7 +30,7 @@
------------------------------------------------------------------------------
private with System;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type (<>) is private;
@@ -100,7 +100,7 @@ private
-- (default) alignment instead.
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder);
type Element_Access is access all Element_Type;
pragma Assert (Element_Access'Size = Standard'Address_Size,
diff --git a/gcc/ada/libgnat/a-cobove.adb b/gcc/ada/libgnat/a-cobove.adb
index 5e61ba9b69c..f32afa1a54b 100644
--- a/gcc/ada/libgnat/a-cobove.adb
+++ b/gcc/ada/libgnat/a-cobove.adb
@@ -2140,7 +2140,7 @@ package body Ada.Containers.Bounded_Vectors is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Vector)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads
index eb8072d4018..67c441920a3 100644
--- a/gcc/ada/libgnat/a-cobove.ads
+++ b/gcc/ada/libgnat/a-cobove.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Index_Type is range <>;
@@ -433,7 +433,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Vector);
procedure Write
(Stream : not null access Root_Stream_Type'Class;
diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb
index affeda3c0b1..26bdd552265 100644
--- a/gcc/ada/libgnat/a-cohama.adb
+++ b/gcc/ada/libgnat/a-cohama.adb
@@ -892,7 +892,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads
index 0ae3298c383..a04cb3a34c6 100644
--- a/gcc/ada/libgnat/a-cohama.ads
+++ b/gcc/ada/libgnat/a-cohama.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
-- The language-defined generic package Containers.Hashed_Maps provides
-- private types Map and Cursor, and a set of operations for each type. A map
@@ -431,7 +431,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb
index 8a55fc34246..31374f6b9d6 100644
--- a/gcc/ada/libgnat/a-cohase.adb
+++ b/gcc/ada/libgnat/a-cohase.adb
@@ -1170,7 +1170,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads
index 0602f5d0dc8..f0763afbcfc 100644
--- a/gcc/ada/libgnat/a-cohase.ads
+++ b/gcc/ada/libgnat/a-cohase.ads
@@ -37,7 +37,7 @@ private with Ada.Containers.Hash_Tables;
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -510,7 +510,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
diff --git a/gcc/ada/libgnat/a-coinho.adb b/gcc/ada/libgnat/a-coinho.adb
index dfaf619e457..ca6882a5204 100644
--- a/gcc/ada/libgnat/a-coinho.adb
+++ b/gcc/ada/libgnat/a-coinho.adb
@@ -235,7 +235,7 @@ package body Ada.Containers.Indefinite_Holders is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder)
is
use System.Put_Images;
begin
diff --git a/gcc/ada/libgnat/a-coinho.ads b/gcc/ada/libgnat/a-coinho.ads
index 3b73db2fcfa..b6488368148 100644
--- a/gcc/ada/libgnat/a-coinho.ads
+++ b/gcc/ada/libgnat/a-coinho.ads
@@ -31,7 +31,7 @@
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type (<>) is private;
@@ -119,7 +119,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder);
for Holder'Read use Read;
for Holder'Write use Write;
diff --git a/gcc/ada/libgnat/a-coinho__shared.adb b/gcc/ada/libgnat/a-coinho__shared.adb
index cac6e6db024..0340af0488a 100644
--- a/gcc/ada/libgnat/a-coinho__shared.adb
+++ b/gcc/ada/libgnat/a-coinho__shared.adb
@@ -325,7 +325,7 @@ package body Ada.Containers.Indefinite_Holders is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder)
is
use System.Put_Images;
begin
diff --git a/gcc/ada/libgnat/a-coinho__shared.ads b/gcc/ada/libgnat/a-coinho__shared.ads
index bb3129b26dd..97f796dcfd5 100644
--- a/gcc/ada/libgnat/a-coinho__shared.ads
+++ b/gcc/ada/libgnat/a-coinho__shared.ads
@@ -36,7 +36,7 @@ private with Ada.Finalization;
private with Ada.Streams;
private with System.Atomic_Counters;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type (<>) is private;
@@ -134,7 +134,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder);
for Holder'Read use Read;
for Holder'Write use Write;
diff --git a/gcc/ada/libgnat/a-coinve.adb b/gcc/ada/libgnat/a-coinve.adb
index aa5ca5ef696..9df6e3d4881 100644
--- a/gcc/ada/libgnat/a-coinve.adb
+++ b/gcc/ada/libgnat/a-coinve.adb
@@ -2670,7 +2670,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Vector)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-coinve.ads b/gcc/ada/libgnat/a-coinve.ads
index c139f7a8021..828ed292689 100644
--- a/gcc/ada/libgnat/a-coinve.ads
+++ b/gcc/ada/libgnat/a-coinve.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Index_Type is range <>;
@@ -428,7 +428,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Vector);
overriding procedure Adjust (Container : in out Vector);
overriding procedure Finalize (Container : in out Vector);
diff --git a/gcc/ada/libgnat/a-comutr.adb b/gcc/ada/libgnat/a-comutr.adb
index e1b3ef6b057..617d248822a 100644
--- a/gcc/ada/libgnat/a-comutr.adb
+++ b/gcc/ada/libgnat/a-comutr.adb
@@ -1864,7 +1864,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Tree)
is
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-comutr.ads b/gcc/ada/libgnat/a-comutr.ads
index a6a534d1c18..8e88b14898c 100644
--- a/gcc/ada/libgnat/a-comutr.ads
+++ b/gcc/ada/libgnat/a-comutr.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -404,7 +404,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Tree);
overriding procedure Adjust (Container : in out Tree);
diff --git a/gcc/ada/libgnat/a-convec.adb b/gcc/ada/libgnat/a-convec.adb
index f9d2c467efc..5cede720ffd 100644
--- a/gcc/ada/libgnat/a-convec.adb
+++ b/gcc/ada/libgnat/a-convec.adb
@@ -2345,7 +2345,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Vector)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-convec.ads b/gcc/ada/libgnat/a-convec.ads
index 53dc6716c57..41eafbcaf5d 100644
--- a/gcc/ada/libgnat/a-convec.ads
+++ b/gcc/ada/libgnat/a-convec.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
-- The language-defined generic package Containers.Vectors provides private
-- types Vector and Cursor, and a set of operations for each type. A vector
@@ -745,7 +745,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Vector);
overriding procedure Adjust (Container : in out Vector);
overriding procedure Finalize (Container : in out Vector);
diff --git a/gcc/ada/libgnat/a-coorma.adb b/gcc/ada/libgnat/a-coorma.adb
index afc36b866de..65adf4c595f 100644
--- a/gcc/ada/libgnat/a-coorma.adb
+++ b/gcc/ada/libgnat/a-coorma.adb
@@ -1220,7 +1220,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-coorma.ads b/gcc/ada/libgnat/a-coorma.ads
index 5740621c921..5de65c18d6b 100644
--- a/gcc/ada/libgnat/a-coorma.ads
+++ b/gcc/ada/libgnat/a-coorma.ads
@@ -36,7 +36,7 @@ with Ada.Iterator_Interfaces;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Key_Type is private;
@@ -267,7 +267,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Map);
overriding procedure Adjust (Container : in out Map);
diff --git a/gcc/ada/libgnat/a-coormu.adb b/gcc/ada/libgnat/a-coormu.adb
index e269eb48d5b..9b11d293140 100644
--- a/gcc/ada/libgnat/a-coormu.adb
+++ b/gcc/ada/libgnat/a-coormu.adb
@@ -1571,7 +1571,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-coormu.ads b/gcc/ada/libgnat/a-coormu.ads
index 423270f223b..51b94eb5e64 100644
--- a/gcc/ada/libgnat/a-coormu.ads
+++ b/gcc/ada/libgnat/a-coormu.ads
@@ -34,7 +34,7 @@
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
with Ada.Iterator_Interfaces;
generic
@@ -476,7 +476,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
diff --git a/gcc/ada/libgnat/a-coorse.adb b/gcc/ada/libgnat/a-coorse.adb
index 8c03e89a213..ca8f238be86 100644
--- a/gcc/ada/libgnat/a-coorse.adb
+++ b/gcc/ada/libgnat/a-coorse.adb
@@ -1586,7 +1586,7 @@ is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set)
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set)
is
First_Time : Boolean := True;
use System.Put_Images;
diff --git a/gcc/ada/libgnat/a-coorse.ads b/gcc/ada/libgnat/a-coorse.ads
index 29a73227dec..6d24e038747 100644
--- a/gcc/ada/libgnat/a-coorse.ads
+++ b/gcc/ada/libgnat/a-coorse.ads
@@ -37,7 +37,7 @@ with Ada.Containers.Helpers;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
generic
type Element_Type is private;
@@ -347,7 +347,7 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Set);
overriding procedure Adjust (Container : in out Set);
diff --git a/gcc/ada/libgnat/a-nbnbin.adb b/gcc/ada/libgnat/a-nbnbin.adb
index 05519435c77..fe41cf1da0e 100644
--- a/gcc/ada/libgnat/a-nbnbin.adb
+++ b/gcc/ada/libgnat/a-nbnbin.adb
@@ -30,7 +30,6 @@
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
-with Ada.Strings.Text_Output.Utils;
with Interfaces; use Interfaces;
@@ -432,12 +431,12 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
-- Put_Image --
---------------
- procedure Put_Image (S : in out Sink'Class; V : Big_Integer) is
+ procedure Put_Image (S : in out Root_Buffer_Type'Class; V : Big_Integer) is
-- This is implemented in terms of To_String. It might be more elegant
-- and more efficient to do it the other way around, but this is the
-- most expedient implementation for now.
begin
- Strings.Text_Output.Utils.Put_UTF_8 (S, To_String (V));
+ Strings.Text_Buffers.Put_UTF_8 (S, To_String (V));
end Put_Image;
---------
diff --git a/gcc/ada/libgnat/a-nbnbin.ads b/gcc/ada/libgnat/a-nbnbin.ads
index 31a8bc956cf..1ba10da6a0d 100644
--- a/gcc/ada/libgnat/a-nbnbin.ads
+++ b/gcc/ada/libgnat/a-nbnbin.ads
@@ -13,7 +13,7 @@
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Text_Output; use Ada.Strings.Text_Output;
+with Ada.Strings.Text_Buffers; use Ada.Strings.Text_Buffers;
private with Ada.Finalization;
private with System;
@@ -119,7 +119,7 @@ is
function From_Universal_Image (Arg : String) return Valid_Big_Integer
renames From_String;
- procedure Put_Image (S : in out Sink'Class; V : Big_Integer);
+ procedure Put_Image (S : in out Root_Buffer_Type'Class; V : Big_Integer);
function "+" (L : Valid_Big_Integer) return Valid_Big_Integer
with Global => null;
diff --git a/gcc/ada/libgnat/a-nbnbin__gmp.adb b/gcc/ada/libgnat/a-nbnbin__gmp.adb
index 98d7d9378b4..880e9a3c53d 100644
--- a/gcc/ada/libgnat/a-nbnbin__gmp.adb
+++ b/gcc/ada/libgnat/a-nbnbin__gmp.adb
@@ -35,7 +35,6 @@ with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
-with Ada.Strings.Text_Output.Utils;
with Ada.Characters.Handling; use Ada.Characters.Handling;
package body Ada.Numerics.Big_Numbers.Big_Integers is
@@ -403,12 +402,12 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
-- Put_Image --
---------------
- procedure Put_Image (S : in out Sink'Class; V : Big_Integer) is
+ procedure Put_Image (S : in out Root_Buffer_Type'Class; V : Big_Integer) is
-- This is implemented in terms of To_String. It might be more elegant
-- and more efficient to do it the other way around, but this is the
-- most expedient implementation for now.
begin
- Strings.Text_Output.Utils.Put_UTF_8 (S, To_String (V));
+ Strings.Text_Buffers.Put_UTF_8 (S, To_String (V));
end Put_Image;
---------
diff --git a/gcc/ada/libgnat/a-nbnbre.adb b/gcc/ada/libgnat/a-nbnbre.adb
index 794e918a81c..e45bc6dd028 100644
--- a/gcc/ada/libgnat/a-nbnbre.adb
+++ b/gcc/ada/libgnat/a-nbnbre.adb
@@ -29,7 +29,6 @@
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Text_Output.Utils;
with System.Unsigned_Types; use System.Unsigned_Types;
package body Ada.Numerics.Big_Numbers.Big_Reals is
@@ -619,12 +618,12 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
-- Put_Image --
---------------
- procedure Put_Image (S : in out Sink'Class; V : Big_Real) is
+ procedure Put_Image (S : in out Root_Buffer_Type'Class; V : Big_Real) is
-- This is implemented in terms of To_String. It might be more elegant
-- and more efficient to do it the other way around, but this is the
-- most expedient implementation for now.
begin
- Strings.Text_Output.Utils.Put_UTF_8 (S, To_String (V));
+ Strings.Text_Buffers.Put_UTF_8 (S, To_String (V));
end Put_Image;
---------
diff --git a/gcc/ada/libgnat/a-nbnbre.ads b/gcc/ada/libgnat/a-nbnbre.ads
index eb7c8a7e572..4118d2bb99c 100644
--- a/gcc/ada/libgnat/a-nbnbre.ads
+++ b/gcc/ada/libgnat/a-nbnbre.ads
@@ -15,7 +15,7 @@
with Ada.Numerics.Big_Numbers.Big_Integers;
-with Ada.Strings.Text_Output; use Ada.Strings.Text_Output;
+with Ada.Strings.Text_Buffers; use Ada.Strings.Text_Buffers;
package Ada.Numerics.Big_Numbers.Big_Reals
with Preelaborate
@@ -138,7 +138,7 @@ is
function From_Quotient_String (Arg : String) return Valid_Big_Real
with Global => null;
- procedure Put_Image (S : in out Sink'Class; V : Big_Real);
+ procedure Put_Image (S : in out Root_Buffer_Type'Class; V : Big_Real);
function "+" (L : Valid_Big_Real) return Valid_Big_Real
with Global => null;
diff --git a/gcc/ada/libgnat/a-stbubo.adb b/gcc/ada/libgnat/a-stbubo.adb
new file mode 100644
index 00000000000..a3e0e32caab
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbubo.adb
@@ -0,0 +1,147 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.BOUNDED --
+-- --
+-- 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.Conversions;
+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_Buffers.Bounded is
+
+ -- Pretty much the same as the Unbounded version, except where different.
+ --
+ -- One could imagine inventing an Input_Mapping generic analogous to
+ -- the existing Output_Mapping generic to address the Get-related
+ -- Bounded/Unbounded code duplication issues, but let's not. In the
+ -- Output case, there was more substantial duplication and there were
+ -- 3 clients (Bounded, Unbounded, and Files) instead of 2.
+
+ function Text_Truncated (Buffer : Buffer_Type) return Boolean is
+ (Buffer.Truncated);
+
+ function Get (Buffer : in out Buffer_Type) return String is
+ -- 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 RM 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.
+ begin
+ if Buffer.All_8_Bits and not Buffer.All_7_Bits then
+ return UTF_Encoding.Strings.Decode (Get_UTF_8 (Buffer));
+ else
+ return Get_UTF_8 (Buffer);
+ end if;
+ end Get;
+
+ function Wide_Get (Buffer : in out Buffer_Type) return Wide_String is
+ begin
+ return UTF_Encoding.Wide_Strings.Decode (Get_UTF_8 (Buffer));
+ end Wide_Get;
+
+ function Wide_Wide_Get (Buffer : in out Buffer_Type) return Wide_Wide_String
+ is
+ begin
+ return UTF_Encoding.Wide_Wide_Strings.Decode (Get_UTF_8 (Buffer));
+ end Wide_Wide_Get;
+
+ function Get_UTF_8
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_8_String
+ is
+ begin
+ return
+ Result : constant UTF_Encoding.UTF_8_String :=
+ UTF_Encoding.UTF_8_String
+ (Buffer.Chars (1 .. Text_Buffer_Count (Buffer.UTF_8_Length)))
+ do
+ -- Reset buffer to default initial value.
+ declare
+ Defaulted : Buffer_Type (0);
+
+ -- If this aggregate becomes illegal due to new field, don't
+ -- forget to add corresponding assignment statement below.
+ Dummy : array (1 .. 0) of Buffer_Type (0) :=
+ (others =>
+ (Max_Characters => 0, Chars => <>, Indentation => <>,
+ Indent_Pending => <>, UTF_8_Length => <>, UTF_8_Column => <>,
+ All_7_Bits => <>, All_8_Bits => <>, Truncated => <>));
+ begin
+ Buffer.Indentation := Defaulted.Indentation;
+ Buffer.Indent_Pending := Defaulted.Indent_Pending;
+ Buffer.UTF_8_Length := Defaulted.UTF_8_Length;
+ Buffer.UTF_8_Column := Defaulted.UTF_8_Column;
+ Buffer.All_7_Bits := Defaulted.All_7_Bits;
+ Buffer.All_8_Bits := Defaulted.All_8_Bits;
+ Buffer.Truncated := Defaulted.Truncated;
+ end;
+ end return;
+ end Get_UTF_8;
+
+ function Wide_Get_UTF_16
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_16_Wide_String
+ is
+ begin
+ return
+ UTF_Encoding.Conversions.Convert
+ (Get_UTF_8 (Buffer), Input_Scheme => UTF_Encoding.UTF_8);
+ end Wide_Get_UTF_16;
+
+ procedure Put_UTF_8_Implementation
+ (Buffer : in out Root_Buffer_Type'Class;
+ Item : UTF_Encoding.UTF_8_String)
+ is
+ procedure Buffer_Type_Implementation (Buffer : in out Buffer_Type);
+ -- View the passed-in Buffer parameter as being of type Buffer_Type,
+ -- not of Root_Buffer_Type'Class.
+
+ procedure Buffer_Type_Implementation (Buffer : in out Buffer_Type) is
+ begin
+ for Char of Item loop
+ if Buffer.UTF_8_Length = Integer (Buffer.Max_Characters) then
+ Buffer.Truncated := True;
+ return;
+ end if;
+
+ Buffer.All_7_Bits := @ and then Character'Pos (Char) < 128;
+
+ Buffer.UTF_8_Length := @ + 1;
+ Buffer.UTF_8_Column := @ + 1;
+ Buffer.Chars (Text_Buffer_Count (Buffer.UTF_8_Length)) := Char;
+ end loop;
+ end Buffer_Type_Implementation;
+ begin
+ if Item'Length > 0 then
+ Buffer_Type_Implementation (Buffer_Type (Buffer));
+ end if;
+ end Put_UTF_8_Implementation;
+
+end Ada.Strings.Text_Buffers.Bounded;
diff --git a/gcc/ada/libgnat/a-stbubo.ads b/gcc/ada/libgnat/a-stbubo.ads
new file mode 100644
index 00000000000..aef7ccf4567
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbubo.ads
@@ -0,0 +1,73 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.BOUNDED --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2020-2021, Free Software Foundation, Inc. --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
+-- --
+------------------------------------------------------------------------------
+
+package Ada.Strings.Text_Buffers.Bounded with
+ Pure
+is
+
+ type Buffer_Type (Max_Characters : Text_Buffer_Count) is
+ new Root_Buffer_Type with private with
+ Default_Initial_Condition => not Text_Truncated (Buffer_Type);
+
+ function Text_Truncated (Buffer : Buffer_Type) return Boolean;
+
+ function Get (Buffer : in out Buffer_Type) return String with
+ Post'Class => Get'Result'First = 1 and then Current_Indent (Buffer) = 0;
+
+ function Wide_Get (Buffer : in out Buffer_Type) return Wide_String with
+ Post'Class => Wide_Get'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+ function Wide_Wide_Get
+ (Buffer : in out Buffer_Type) return Wide_Wide_String with
+ Post'Class => Wide_Wide_Get'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+ function Get_UTF_8
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_8_String with
+ Post'Class => Get_UTF_8'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+ function Wide_Get_UTF_16
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_16_Wide_String with
+ Post'Class => Wide_Get_UTF_16'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+private
+
+ procedure Put_UTF_8_Implementation
+ (Buffer : in out Root_Buffer_Type'Class;
+ Item : UTF_Encoding.UTF_8_String)
+ with Pre => Buffer in Buffer_Type'Class;
+
+ package Mapping is new Output_Mapping (Put_UTF_8_Implementation);
+
+ subtype Positive_Text_Buffer_Count is
+ Text_Buffer_Count range 1 .. Text_Buffer_Count'Last;
+
+ type Convertible_To_UTF_8_String is
+ array (Positive_Text_Buffer_Count range <>) of Character;
+
+ type Buffer_Type (Max_Characters : Text_Buffer_Count)
+ is new Mapping.Buffer_Type with record
+ Truncated : Boolean := False;
+ -- True if we ran out of space on a Put
+
+ Chars : Convertible_To_UTF_8_String (1 .. Max_Characters);
+ end record;
+
+end Ada.Strings.Text_Buffers.Bounded;
diff --git a/gcc/ada/libgnat/a-stbufi.adb b/gcc/ada/libgnat/a-stbufi.adb
new file mode 100644
index 00000000000..0a8feab5989
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbufi.adb
@@ -0,0 +1,82 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.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. --
+-- --
+------------------------------------------------------------------------------
+
+package body Ada.Strings.Text_Buffers.Files is
+
+ procedure Put_UTF_8_Implementation
+ (Buffer : in out Root_Buffer_Type'Class;
+ Item : UTF_Encoding.UTF_8_String) is
+ Result : Integer;
+ begin
+ Result := OS.Write (File_Buffer (Buffer).FD,
+ Item (Item'First)'Address,
+ Item'Length);
+ if Result /= Item'Length then
+ raise Program_Error with OS.Errno_Message;
+ end if;
+ end Put_UTF_8_Implementation;
+
+ function Create_From_FD
+ (FD : GNAT.OS_Lib.File_Descriptor;
+ Close_Upon_Finalization : Boolean := True) return File_Buffer
+ is
+ use OS;
+ begin
+ if FD = Invalid_FD then
+ raise Program_Error with OS.Errno_Message;
+ end if;
+ return Result : File_Buffer do
+ Result.FD := FD;
+ Result.Close_Upon_Finalization := Close_Upon_Finalization;
+ end return;
+ end Create_From_FD;
+
+ function Create_File (Name : String) return File_Buffer is
+ begin
+ return Create_From_FD (OS.Create_File (Name, Fmode => OS.Binary));
+ end Create_File;
+
+ procedure Finalize (Ref : in out Self_Ref) is
+ Success : Boolean;
+ use OS;
+ begin
+ if Ref.Self.FD /= OS.Invalid_FD
+ and then Ref.Self.Close_Upon_Finalization
+ then
+ Close (Ref.Self.FD, Success);
+ if not Success then
+ raise Program_Error with OS.Errno_Message;
+ end if;
+ end if;
+ Ref.Self.FD := OS.Invalid_FD;
+ end Finalize;
+
+end Ada.Strings.Text_Buffers.Files;
diff --git a/gcc/ada/libgnat/a-stbufi.ads b/gcc/ada/libgnat/a-stbufi.ads
new file mode 100644
index 00000000000..2a2db9002cc
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbufi.ads
@@ -0,0 +1,75 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.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. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Finalization;
+with GNAT.OS_Lib;
+
+package Ada.Strings.Text_Buffers.Files is
+
+ type File_Buffer is new Root_Buffer_Type with private;
+ -- Output written to a File_Buffer is written to the associated file.
+
+ function Create_From_FD
+ (FD : GNAT.OS_Lib.File_Descriptor;
+ Close_Upon_Finalization : Boolean := True)
+ return File_Buffer;
+ -- file closed upon finalization if specified
+
+ function Create_File (Name : String) return File_Buffer;
+ -- file closed upon finalization
+
+ function Create_Standard_Output_Buffer return File_Buffer is
+ (Create_From_FD (GNAT.OS_Lib.Standout, Close_Upon_Finalization => False));
+ function Create_Standard_Error_Buffer return File_Buffer is
+ (Create_From_FD (GNAT.OS_Lib.Standerr, Close_Upon_Finalization => False));
+
+private
+
+ procedure Put_UTF_8_Implementation
+ (Buffer : in out Root_Buffer_Type'Class;
+ Item : UTF_Encoding.UTF_8_String)
+ with Pre => Buffer in File_Buffer'Class;
+
+ package Mapping is new Output_Mapping (Put_UTF_8_Implementation);
+
+ package OS renames GNAT.OS_Lib;
+
+ type Self_Ref (Self : not null access File_Buffer)
+ is new Finalization.Limited_Controlled with null record;
+ overriding procedure Finalize (Ref : in out Self_Ref);
+
+ type File_Buffer is new Mapping.Buffer_Type with record
+ FD : OS.File_Descriptor := OS.Invalid_FD;
+ Ref : Self_Ref (File_Buffer'Access);
+ Close_Upon_Finalization : Boolean := False;
+ end record;
+
+end Ada.Strings.Text_Buffers.Files;
diff --git a/gcc/ada/libgnat/a-stbufo.adb b/gcc/ada/libgnat/a-stbufo.adb
new file mode 100644
index 00000000000..8ac55128e35
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbufo.adb
@@ -0,0 +1,158 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.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_Buffers.Unbounded;
+with Ada.Strings.Text_Buffers.Files;
+
+package body Ada.Strings.Text_Buffers.Formatting is
+
+ use Ada.Strings.Text_Buffers.Files;
+ use Ada.Strings.Text_Buffers.Utils;
+
+ procedure Put
+ (S : in out Root_Buffer_Type'Class; T : Template;
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.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' =>
+ Increase_Indent (S);
+ when 'o' =>
+ Decrease_Indent (S);
+ when 'I' =>
+ Increase_Indent (S, 1);
+ when 'O' =>
+ Decrease_Indent (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;
+ end Put;
+
+ function Format
+ (T : Template;
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "")
+ return Utils.UTF_8_Lines
+ is
+ Buffer : Unbounded.Buffer_Type;
+ begin
+ Put (Buffer, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
+ return Buffer.Get_UTF_8;
+ end Format;
+
+ procedure Put
+ (T : Template;
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "") is
+ Buffer : File_Buffer := Create_Standard_Output_Buffer;
+ begin
+ Put (Buffer, 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 : Utils.UTF_8_Lines := "") is
+ Buffer : File_Buffer := Create_Standard_Error_Buffer;
+ begin
+ Put (Buffer, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
+ end Err;
+
+end Ada.Strings.Text_Buffers.Formatting;
diff --git a/gcc/ada/libgnat/a-stbufo.ads b/gcc/ada/libgnat/a-stbufo.ads
new file mode 100644
index 00000000000..8c0d4761204
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbufo.ads
@@ -0,0 +1,73 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.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. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Strings.Text_Buffers.Utils;
+
+package Ada.Strings.Text_Buffers.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.
+
+ type Template is new Utils.UTF_8;
+
+ procedure Put
+ (S : in out Root_Buffer_Type'Class; T : Template;
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.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 : Utils.UTF_8_Lines := "");
+ -- Sends to standard output
+
+ procedure Err
+ (T : Template;
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "");
+ -- Sends to standard error
+
+ function Format
+ (T : Template;
+ X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "")
+ return Utils.UTF_8_Lines;
+ -- Returns a UTF-8-encoded String
+
+end Ada.Strings.Text_Buffers.Formatting;
diff --git a/gcc/ada/libgnat/a-stbuun.adb b/gcc/ada/libgnat/a-stbuun.adb
new file mode 100644
index 00000000000..9ae3d28c6cb
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbuun.adb
@@ -0,0 +1,193 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.UNBOUNDED --
+-- --
+-- 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.Unchecked_Deallocation;
+with Ada.Strings.UTF_Encoding.Conversions;
+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_Buffers.Unbounded is
+
+ function Get (Buffer : in out Buffer_Type) return String is
+ -- 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 RM 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.
+ begin
+ if Buffer.All_8_Bits and not Buffer.All_7_Bits then
+ return UTF_Encoding.Strings.Decode (Get_UTF_8 (Buffer));
+ else
+ return Get_UTF_8 (Buffer);
+ end if;
+ end Get;
+
+ function Wide_Get (Buffer : in out Buffer_Type) return Wide_String is
+ begin
+ return UTF_Encoding.Wide_Strings.Decode (Get_UTF_8 (Buffer));
+ end Wide_Get;
+
+ function Wide_Wide_Get (Buffer : in out Buffer_Type) return Wide_Wide_String
+ is
+ begin
+ return UTF_Encoding.Wide_Wide_Strings.Decode (Get_UTF_8 (Buffer));
+ end Wide_Wide_Get;
+
+ function Get_UTF_8
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_8_String
+ is
+ begin
+ return Result : UTF_Encoding.UTF_8_String (1 .. Buffer.UTF_8_Length) do
+ declare
+ Target_First : Positive := 1;
+ Ptr : Chunk_Access := Buffer.List.First_Chunk'Unchecked_Access;
+ Target_Last : Positive;
+ begin
+ while Ptr /= null loop
+ Target_Last := Target_First + Ptr.Chars'Length - 1;
+ if Target_Last <= Result'Last then
+ -- all of chunk is assigned to Result
+ Result (Target_First .. Target_Last) := Ptr.Chars;
+ Target_First := Target_First + Ptr.Chars'Length;
+ else
+ -- only part of (last) chunk is assigned to Result
+ declare
+ Final_Target : UTF_Encoding.UTF_8_String renames
+ Result (Target_First .. Result'Last);
+ begin
+ Final_Target := Ptr.Chars (1 .. Final_Target'Length);
+ end;
+ pragma Assert (Ptr.Next = null);
+ Target_First := Integer'Last;
+ end if;
+
+ Ptr := Ptr.Next;
+ end loop;
+ end;
+
+ -- Reset buffer to default initial value.
+ declare
+ Defaulted : Buffer_Type;
+
+ -- If this aggregate becomes illegal due to new field, don't
+ -- forget to add corresponding assignment statement below.
+ Dummy : array (1 .. 0) of Buffer_Type :=
+ (others =>
+ (Indentation => <>, Indent_Pending => <>, UTF_8_Length => <>,
+ UTF_8_Column => <>, All_7_Bits => <>, All_8_Bits => <>,
+ List => <>, Last_Used => <>));
+ begin
+ Buffer.Indentation := Defaulted.Indentation;
+ Buffer.Indent_Pending := Defaulted.Indent_Pending;
+ Buffer.UTF_8_Length := Defaulted.UTF_8_Length;
+ Buffer.UTF_8_Column := Defaulted.UTF_8_Column;
+ Buffer.All_7_Bits := Defaulted.All_7_Bits;
+ Buffer.All_8_Bits := Defaulted.All_8_Bits;
+ Buffer.Last_Used := Defaulted.Last_Used;
+ Finalize (Buffer.List); -- free any allocated chunks
+ end;
+ end return;
+ end Get_UTF_8;
+
+ function Wide_Get_UTF_16
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_16_Wide_String
+ is
+ begin
+ return
+ UTF_Encoding.Conversions.Convert
+ (Get_UTF_8 (Buffer), Input_Scheme => UTF_Encoding.UTF_8);
+ end Wide_Get_UTF_16;
+
+ procedure Put_UTF_8_Implementation
+ (Buffer : in out Root_Buffer_Type'Class;
+ Item : UTF_Encoding.UTF_8_String)
+ is
+ procedure Buffer_Type_Implementation (Buffer : in out Buffer_Type);
+ -- View the passed-in Buffer parameter as being of type Buffer_Type,
+ -- not of type Root_Buffer_Type'Class.
+
+ procedure Buffer_Type_Implementation (Buffer : in out Buffer_Type) is
+ begin
+ for Char of Item loop
+ Buffer.All_7_Bits := @ and then Character'Pos (Char) < 128;
+
+ if Buffer.Last_Used = Buffer.List.Current_Chunk.Length then
+ -- Current chunk is full; allocate a new one with doubled size
+
+ declare
+ Cc : Chunk renames Buffer.List.Current_Chunk.all;
+ Max : constant Positive := Integer'Last / 2;
+ Length : constant Natural :=
+ Integer'Min (Max, 2 * Cc.Length);
+ begin
+ pragma Assert (Cc.Next = null);
+ Cc.Next := new Chunk (Length => Length);
+ Buffer.List.Current_Chunk := Cc.Next;
+ Buffer.Last_Used := 0;
+ end;
+ end if;
+
+ Buffer.UTF_8_Length := @ + 1;
+ Buffer.UTF_8_Column := @ + 1;
+ Buffer.Last_Used := @ + 1;
+ Buffer.List.Current_Chunk.Chars (Buffer.Last_Used) := Char;
+ end loop;
+ end Buffer_Type_Implementation;
+ begin
+ Buffer_Type_Implementation (Buffer_Type (Buffer));
+ end Put_UTF_8_Implementation;
+
+ procedure Initialize (List : in out Managed_Chunk_List) is
+ begin
+ List.Current_Chunk := List.First_Chunk'Unchecked_Access;
+ end Initialize;
+
+ procedure Finalize (List : in out Managed_Chunk_List) is
+ procedure Free is new Ada.Unchecked_Deallocation (Chunk, Chunk_Access);
+ Ptr : Chunk_Access := List.First_Chunk.Next;
+ begin
+ while Ptr /= null loop
+ declare
+ Old_Ptr : Chunk_Access := Ptr;
+ begin
+ Ptr := Ptr.Next;
+ Free (Old_Ptr);
+ end;
+ end loop;
+
+ List.First_Chunk.Next := null;
+ Initialize (List);
+ end Finalize;
+
+end Ada.Strings.Text_Buffers.Unbounded;
diff --git a/gcc/ada/libgnat/a-stbuun.ads b/gcc/ada/libgnat/a-stbuun.ads
new file mode 100644
index 00000000000..3c6ad3a015e
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbuun.ads
@@ -0,0 +1,87 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.UNBOUNDED --
+-- --
+-- S p e c --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Finalization;
+package Ada.Strings.Text_Buffers.Unbounded with
+ Preelaborate
+ -- , Nonblocking
+ -- , Global => null
+is
+
+ type Buffer_Type is new Root_Buffer_Type with private;
+
+ function Get (Buffer : in out Buffer_Type) return String with
+ Post'Class => Get'Result'First = 1 and then Current_Indent (Buffer) = 0;
+
+ function Wide_Get (Buffer : in out Buffer_Type) return Wide_String with
+ Post'Class => Wide_Get'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+ function Wide_Wide_Get
+ (Buffer : in out Buffer_Type) return Wide_Wide_String with
+ Post'Class => Wide_Wide_Get'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+ function Get_UTF_8
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_8_String with
+ Post'Class => Get_UTF_8'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+ function Wide_Get_UTF_16
+ (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_16_Wide_String with
+ Post'Class => Wide_Get_UTF_16'Result'First = 1
+ and then Current_Indent (Buffer) = 0;
+
+private
+
+ procedure Put_UTF_8_Implementation
+ (Buffer : in out Root_Buffer_Type'Class;
+ Item : UTF_Encoding.UTF_8_String)
+ with Pre => Buffer in Buffer_Type'Class;
+
+ package Mapping is new Output_Mapping (Put_UTF_8_Implementation);
+
+ type Chunk;
+ type Chunk_Access is access all Chunk;
+ type Chunk (Length : Positive) is record
+ Next : Chunk_Access := null;
+ Chars : UTF_Encoding.UTF_8_String (1 .. Length);
+ end record;
+
+ type Managed_Chunk_List is new Ada.Finalization.Limited_Controlled with
+ record
+ First_Chunk : aliased Chunk (64);
+ -- First chunk in list is not created by an allocator; it is
+ -- large enough to suffice for many common images.
+
+ Current_Chunk : Chunk_Access;
+ -- Chunk we are currrently writing to.
+ -- Initialized to Managed_Chunk_List.First'Access.
+ end record;
+
+ overriding procedure Initialize (List : in out Managed_Chunk_List);
+ -- List.Current_Chunk := List.First_Chunk'Unchecked_Access;
+
+ overriding procedure Finalize (List : in out Managed_Chunk_List);
+ -- Free any allocated chunks.
+
+ type Buffer_Type is new Mapping.Buffer_Type with record
+ List : Managed_Chunk_List;
+
+ Last_Used : Natural := 0;
+ -- Index of last used char in List.Current_Chunk.all; 0 if none used.
+ end record;
+
+end Ada.Strings.Text_Buffers.Unbounded;
diff --git a/gcc/ada/libgnat/a-stbuut.adb b/gcc/ada/libgnat/a-stbuut.adb
new file mode 100644
index 00000000000..b32b2d38d75
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbuut.adb
@@ -0,0 +1,81 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.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. --
+-- --
+------------------------------------------------------------------------------
+
+package body Ada.Strings.Text_Buffers.Utils is
+
+ procedure Put_7bit
+ (Buffer : in out Root_Buffer_Type'Class; Item : Character_7)
+ is
+ begin
+ Put (Buffer, (1 => Item));
+ end Put_7bit;
+
+ procedure Put_Character
+ (Buffer : in out Root_Buffer_Type'Class; Item : Character)
+ is
+ begin
+ Put (Buffer, (1 => Item));
+ end Put_Character;
+
+ procedure Put_Wide_Character
+ (Buffer : in out Root_Buffer_Type'Class; Item : Wide_Character)
+ is
+ begin
+ Wide_Put (Buffer, (1 => Item));
+ end Put_Wide_Character;
+
+ procedure Put_Wide_Wide_Character
+ (Buffer : in out Root_Buffer_Type'Class; Item : Wide_Wide_Character)
+ is
+ begin
+ Wide_Wide_Put (Buffer, (1 => Item));
+ end Put_Wide_Wide_Character;
+
+ procedure Put_UTF_8_Lines
+ (Buffer : in out Root_Buffer_Type'Class; Item : UTF_8_Lines)
+ is
+ begin
+ Put (Buffer, Item);
+ end Put_UTF_8_Lines;
+
+ function Column (Buffer : Root_Buffer_Type'Class) return Positive is
+ begin
+ return Buffer.UTF_8_Column;
+ end Column;
+
+ procedure Tab_To_Column
+ (Buffer : in out Root_Buffer_Type'Class; Column : Positive)
+ is
+ begin
+ Put (Buffer, String'(1 .. Column - Utils.Column (Buffer) => ' '));
+ end Tab_To_Column;
+
+end Ada.Strings.Text_Buffers.Utils;
diff --git a/gcc/ada/libgnat/a-stbuut.ads b/gcc/ada/libgnat/a-stbuut.ads
new file mode 100644
index 00000000000..d76b8cfd87a
--- /dev/null
+++ b/gcc/ada/libgnat/a-stbuut.ads
@@ -0,0 +1,82 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS.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. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
+
+package Ada.Strings.Text_Buffers.Utils with Pure is
+
+ -- Ada.Strings.Text_Buffers is a predefined unit (see Ada RM A.4.12).
+ -- This is a GNAT-defined child unit of that parent.
+
+ subtype Character_7 is
+ Character range Character'Val (0) .. Character'Val (2**7 - 1);
+
+ procedure Put_7bit
+ (Buffer : in out Root_Buffer_Type'Class; Item : Character_7);
+ procedure Put_Character
+ (Buffer : in out Root_Buffer_Type'Class; Item : Character);
+ procedure Put_Wide_Character
+ (Buffer : in out Root_Buffer_Type'Class; Item : Wide_Character);
+ procedure Put_Wide_Wide_Character
+ (Buffer : in out Root_Buffer_Type'Class; Item : Wide_Wide_Character);
+ -- Single character output procedures.
+
+ function Column (Buffer : Root_Buffer_Type'Class) return Positive with
+ Inline;
+ -- Current output column. The Column is initially 1, and is incremented for
+ -- each 8-bit character output. A call to New_Line sets Column back to 1.
+ -- The next character to be output will go in this column.
+
+ procedure Tab_To_Column
+ (Buffer : in out Root_Buffer_Type'Class; Column : Positive);
+ -- Put spaces until we're at or past Column.
+
+ subtype Sink is Root_Buffer_Type;
+
+ function NL return Character is (ASCII.LF) with Inline;
+
+ function UTF_8_Length (Buffer : Root_Buffer_Type'Class) return Natural;
+
+ 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);
+
+ procedure Put_UTF_8_Lines
+ (Buffer : in out Root_Buffer_Type'Class; Item : UTF_8_Lines);
+
+private
+ function UTF_8_Length (Buffer : Root_Buffer_Type'Class) return Natural
+ is (Buffer.UTF_8_Length);
+end Ada.Strings.Text_Buffers.Utils;
diff --git a/gcc/ada/libgnat/a-strunb.adb b/gcc/ada/libgnat/a-strunb.adb
index 36dc7efc0f1..4727f965486 100644
--- a/gcc/ada/libgnat/a-strunb.adb
+++ b/gcc/ada/libgnat/a-strunb.adb
@@ -783,7 +783,8 @@ package body Ada.Strings.Unbounded is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String) is
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+ V : Unbounded_String) is
begin
String'Put_Image (S, To_String (V));
end Put_Image;
diff --git a/gcc/ada/libgnat/a-strunb.ads b/gcc/ada/libgnat/a-strunb.ads
index d434cfe3e06..89c8339d753 100644
--- a/gcc/ada/libgnat/a-strunb.ads
+++ b/gcc/ada/libgnat/a-strunb.ads
@@ -41,7 +41,7 @@ pragma Assertion_Policy (Pre => Ignore);
with Ada.Strings.Maps;
with Ada.Finalization;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
-- The language-defined package Strings.Unbounded provides a private type
-- Unbounded_String and a set of operations. An object of type
@@ -748,7 +748,8 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+ V : Unbounded_String);
-- The Unbounded_String is using a buffered implementation to increase
-- speed of the Append/Delete/Insert procedures. The Reference string
diff --git a/gcc/ada/libgnat/a-strunb__shared.adb b/gcc/ada/libgnat/a-strunb__shared.adb
index d2907f63ac7..506b614f7bf 100644
--- a/gcc/ada/libgnat/a-strunb__shared.adb
+++ b/gcc/ada/libgnat/a-strunb__shared.adb
@@ -1291,7 +1291,8 @@ package body Ada.Strings.Unbounded is
---------------
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String) is
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+ V : Unbounded_String) is
begin
String'Put_Image (S, To_String (V));
end Put_Image;
diff --git a/gcc/ada/libgnat/a-strunb__shared.ads b/gcc/ada/libgnat/a-strunb__shared.ads
index 094bf7e4d1c..6382252b908 100644
--- a/gcc/ada/libgnat/a-strunb__shared.ads
+++ b/gcc/ada/libgnat/a-strunb__shared.ads
@@ -78,7 +78,7 @@ pragma Assertion_Policy (Pre => Ignore);
with Ada.Strings.Maps;
private with Ada.Finalization;
private with System.Atomic_Counters;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
package Ada.Strings.Unbounded with
Initial_Condition => Length (Null_Unbounded_String) = 0
@@ -744,7 +744,8 @@ private
end record with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
+ V : Unbounded_String);
pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String);
-- Provide stream routines without dragging in Ada.Streams
diff --git a/gcc/ada/libgnat/a-sttebu.adb b/gcc/ada/libgnat/a-sttebu.adb
new file mode 100644
index 00000000000..bc0c6ce4355
--- /dev/null
+++ b/gcc/ada/libgnat/a-sttebu.adb
@@ -0,0 +1,121 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_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 Ada.Strings.UTF_Encoding.Wide_Strings;
+with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
+
+package body Ada.Strings.Text_Buffers is
+ function Current_Indent
+ (Buffer : Root_Buffer_Type) return Text_Buffer_Count is
+ (Text_Buffer_Count (Buffer.Indentation));
+
+ procedure Increase_Indent
+ (Buffer : in out Root_Buffer_Type;
+ Amount : Text_Buffer_Count := Standard_Indent)
+ is
+ begin
+ Buffer.Indentation := @ + Natural (Amount);
+ end Increase_Indent;
+
+ procedure Decrease_Indent
+ (Buffer : in out Root_Buffer_Type;
+ Amount : Text_Buffer_Count := Standard_Indent)
+ is
+ begin
+ Buffer.Indentation := @ - Natural (Amount);
+ end Decrease_Indent;
+
+ package body Output_Mapping is
+ -- Implement indentation in Put_UTF_8 and New_Line.
+ -- Implement other output procedures using Put_UTF_8.
+
+ procedure Put (Buffer : in out Buffer_Type; Item : String) is
+ begin
+ Put_UTF_8 (Buffer, Item);
+ end Put;
+
+ procedure Wide_Put (Buffer : in out Buffer_Type; Item : Wide_String) is
+ begin
+ Buffer.All_8_Bits :=
+ @ and then
+ (for all WChar of Item => Wide_Character'Pos (WChar) < 256);
+
+ Put_UTF_8 (Buffer, UTF_Encoding.Wide_Strings.Encode (Item));
+ end Wide_Put;
+
+ procedure Wide_Wide_Put
+ (Buffer : in out Buffer_Type; Item : Wide_Wide_String)
+ is
+ begin
+ Buffer.All_8_Bits :=
+ @ and then
+ (for all WWChar of Item => Wide_Wide_Character'Pos (WWChar) < 256);
+
+ Put_UTF_8 (Buffer, UTF_Encoding.Wide_Wide_Strings.Encode (Item));
+ end Wide_Wide_Put;
+
+ procedure Put_UTF_8
+ (Buffer : in out Buffer_Type;
+ Item : UTF_Encoding.UTF_8_String) is
+ begin
+ if Item'Length = 0 then
+ return;
+ end if;
+
+ if Buffer.Indent_Pending then
+ Buffer.Indent_Pending := False;
+ if Buffer.Indentation > 0 then
+ Put_UTF_8_Implementation
+ (Buffer, (1 .. Buffer.Indentation => ' '));
+ end if;
+ end if;
+
+ Put_UTF_8_Implementation (Buffer, Item);
+ end Put_UTF_8;
+
+ procedure Wide_Put_UTF_16
+ (Buffer : in out Buffer_Type; Item : UTF_Encoding.UTF_16_Wide_String)
+ is
+ begin
+ Wide_Wide_Put (Buffer, UTF_Encoding.Wide_Wide_Strings.Decode (Item));
+ end Wide_Put_UTF_16;
+
+ procedure New_Line (Buffer : in out Buffer_Type) is
+ begin
+ Buffer.Indent_Pending := False; -- just for a moment
+ Put (Buffer, (1 => ASCII.LF));
+ Buffer.Indent_Pending := True;
+ Buffer.UTF_8_Column := 1;
+ end New_Line;
+
+ end Output_Mapping;
+
+end Ada.Strings.Text_Buffers;
diff --git a/gcc/ada/libgnat/a-sttebu.ads b/gcc/ada/libgnat/a-sttebu.ads
new file mode 100644
index 00000000000..4f6fafc09b3
--- /dev/null
+++ b/gcc/ada/libgnat/a-sttebu.ads
@@ -0,0 +1,135 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- ADA.STRINGS.TEXT_BUFFERS --
+-- --
+-- S p e c --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Strings.UTF_Encoding;
+package Ada.Strings.Text_Buffers with
+ Pure
+is
+
+ type Text_Buffer_Count is range 0 .. Integer'Last;
+
+ New_Line_Count : constant Text_Buffer_Count := 1;
+ -- There is no support for two-character CR/LF line endings.
+
+ type Root_Buffer_Type is abstract tagged limited private with
+ Default_Initial_Condition => Current_Indent (Root_Buffer_Type) = 0;
+
+ procedure Put (Buffer : in out Root_Buffer_Type; Item : String) is abstract;
+
+ procedure Wide_Put
+ (Buffer : in out Root_Buffer_Type; Item : Wide_String) is abstract;
+
+ procedure Wide_Wide_Put
+ (Buffer : in out Root_Buffer_Type; Item : Wide_Wide_String) is abstract;
+
+ procedure Put_UTF_8
+ (Buffer : in out Root_Buffer_Type;
+ Item : UTF_Encoding.UTF_8_String) is abstract;
+
+ procedure Wide_Put_UTF_16
+ (Buffer : in out Root_Buffer_Type;
+ Item : UTF_Encoding.UTF_16_Wide_String) is abstract;
+
+ procedure New_Line (Buffer : in out Root_Buffer_Type) is abstract;
+
+ Standard_Indent : constant Text_Buffer_Count := 3;
+
+ function Current_Indent
+ (Buffer : Root_Buffer_Type) return Text_Buffer_Count;
+
+ procedure Increase_Indent
+ (Buffer : in out Root_Buffer_Type;
+ Amount : Text_Buffer_Count := Standard_Indent) with
+ Post'Class => Current_Indent (Buffer) =
+ Current_Indent (Buffer)'Old + Amount;
+
+ procedure Decrease_Indent
+ (Buffer : in out Root_Buffer_Type;
+ Amount : Text_Buffer_Count := Standard_Indent) with
+ Pre'Class => Current_Indent (Buffer) >= Amount
+ or else raise Constraint_Error,
+ Post'Class => Current_Indent (Buffer) =
+ Current_Indent (Buffer)'Old - Amount;
+
+private
+
+ type Root_Buffer_Type is abstract tagged limited record
+ Indentation : Natural := 0;
+ -- Current indentation
+
+ Indent_Pending : Boolean := True;
+ -- Set by calls to New_Line, cleared when indentation emitted.
+
+ UTF_8_Length : Natural := 0;
+ -- Count of UTF_8 characters in the buffer
+
+ UTF_8_Column : Positive := 1;
+ -- Column in which next character will be written.
+ -- Calling New_Line resets to 1.
+
+ All_7_Bits : Boolean := True;
+ -- True if all characters seen so far fit in 7 bits
+ All_8_Bits : Boolean := True;
+ -- True if all characters seen so far fit in 8 bits
+
+ end record;
+
+ generic
+ -- This generic allows a client to extend Root_Buffer_Type without
+ -- having to implement any of the abstract subprograms other than
+ -- Put_UTF_8 (i.e., Put, Wide_Put, Wide_Wide_Put, Wide_Put_UTF_16,
+ -- and New_Line). Without this generic, each client would have to
+ -- duplicate the implementations of those 5 subprograms.
+ -- This generic also takes care of handling indentation, thereby
+ -- avoiding further code duplication. The name "Output_Mapping" isn't
+ -- wonderful, but it refers to the idea that this package knows how
+ -- to implement all the other output operations in terms of
+ -- just Put_UTF_8.
+ --
+ -- The classwide parameter type here is somewhat tricky;
+ -- there are no dispatching calls associated with this parameter.
+ -- It would be more accurate to say that the parameter is of type
+ -- Output_Mapping.Buffer_Type'Class, but that type hasn't been declared
+ -- yet. Instantiators will typically declare a non-abstract extension,
+ -- B2, of the buffer type, B1, declared in their instantiation. The
+ -- actual Put_UTF_8_Implementation parameter may then have a
+ -- precondition "Buffer in B2'Class" and that subprogram can safely
+ -- access components declared as part of the declaration of B2.
+
+ with procedure Put_UTF_8_Implementation
+ (Buffer : in out Root_Buffer_Type'Class;
+ Item : UTF_Encoding.UTF_8_String);
+ package Output_Mapping is
+ type Buffer_Type is abstract new Root_Buffer_Type with null record;
+
+ overriding procedure Put (Buffer : in out Buffer_Type; Item : String);
+
+ overriding procedure Wide_Put
+ (Buffer : in out Buffer_Type; Item : Wide_String);
+
+ overriding procedure Wide_Wide_Put
+ (Buffer : in out Buffer_Type; Item : Wide_Wide_String);
+
+ overriding procedure Put_UTF_8
+ (Buffer : in out Buffer_Type;
+ Item : UTF_Encoding.UTF_8_String);
+
+ overriding procedure Wide_Put_UTF_16
+ (Buffer : in out Buffer_Type; Item : UTF_Encoding.UTF_16_Wide_String);
+
+ overriding procedure New_Line (Buffer : in out Buffer_Type);
+ end Output_Mapping;
+
+end Ada.Strings.Text_Buffers;
diff --git a/gcc/ada/libgnat/a-stteou__bootstrap.ads b/gcc/ada/libgnat/a-stteou__bootstrap.ads
deleted file mode 100644
index 0112491d0fa..00000000000
--- a/gcc/ada/libgnat/a-stteou__bootstrap.ads
+++ /dev/null
@@ -1,190 +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. --
--- --
-------------------------------------------------------------------------------
-
--- Simplified version used during bootstrap only
-
-with Ada.Strings.UTF_Encoding;
-
-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;
-
- subtype UTF_8 is UTF_8_Lines;
-
- 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;
diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb
index b0fdae2b0be..33960a4591b 100644
--- a/gcc/ada/libgnat/s-putima.adb
+++ b/gcc/ada/libgnat/s-putima.adb
@@ -29,10 +29,10 @@
-- --
------------------------------------------------------------------------------
+with Ada.Strings.Text_Buffers.Utils;
+use Ada.Strings.Text_Buffers;
+use Ada.Strings.Text_Buffers.Utils;
with Unchecked_Conversion;
-with Ada.Strings.Text_Output.Utils;
-use Ada.Strings.Text_Output;
-use Ada.Strings.Text_Output.Utils;
package body System.Put_Images is
@@ -215,7 +215,7 @@ package body System.Put_Images is
begin
New_Line (S);
Put_7bit (S, '[');
- Indent (S, 1);
+ Increase_Indent (S, 1);
end Array_Before;
procedure Array_Between (S : in out Sink'Class) is
@@ -226,7 +226,7 @@ package body System.Put_Images is
procedure Array_After (S : in out Sink'Class) is
begin
- Outdent (S, 1);
+ Decrease_Indent (S, 1);
Put_7bit (S, ']');
end Array_After;
@@ -244,7 +244,7 @@ package body System.Put_Images is
begin
New_Line (S);
Put_7bit (S, '(');
- Indent (S, 1);
+ Increase_Indent (S, 1);
end Record_Before;
procedure Record_Between (S : in out Sink'Class) is
@@ -255,7 +255,7 @@ package body System.Put_Images is
procedure Record_After (S : in out Sink'Class) is
begin
- Outdent (S, 1);
+ Decrease_Indent (S, 1);
Put_7bit (S, ')');
end Record_After;
@@ -267,7 +267,7 @@ package body System.Put_Images is
procedure Put_Image_Unknown (S : in out Sink'Class; Type_Name : String) is
begin
Put_UTF_8 (S, "{");
- Put_String (S, Type_Name);
+ Put (S, Type_Name);
Put_UTF_8 (S, " object}");
end Put_Image_Unknown;
diff --git a/gcc/ada/libgnat/s-putima.ads b/gcc/ada/libgnat/s-putima.ads
index e94c9b85e1a..4a33e79919c 100644
--- a/gcc/ada/libgnat/s-putima.ads
+++ b/gcc/ada/libgnat/s-putima.ads
@@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Text_Output;
+with Ada.Strings.Text_Buffers;
with System.Unsigned_Types;
package System.Put_Images with Pure is
@@ -50,7 +50,7 @@ package System.Put_Images with Pure is
pragma Preelaborate;
- subtype Sink is Ada.Strings.Text_Output.Sink;
+ subtype Sink is Ada.Strings.Text_Buffers.Root_Buffer_Type;
procedure Put_Image_Integer (S : in out Sink'Class; X : Integer);
procedure Put_Image_Long_Long_Integer
diff --git a/gcc/ada/libgnat/s-rannum.adb b/gcc/ada/libgnat/s-rannum.adb
index 0a1565b83d7..92a91a602e2 100644
--- a/gcc/ada/libgnat/s-rannum.adb
+++ b/gcc/ada/libgnat/s-rannum.adb
@@ -86,7 +86,6 @@
-- --
------------------------------------------------------------------------------
-with Ada.Strings.Text_Output.Utils;
with Ada.Unchecked_Conversion;
with System.Random_Seed;
@@ -689,9 +688,9 @@ is
---------------
procedure Put_Image
- (S : in out Strings.Text_Output.Sink'Class; V : State) is
+ (S : in out Strings.Text_Buffers.Root_Buffer_Type'Class; V : State) is
begin
- Strings.Text_Output.Utils.Put_String (S, Image (V));
+ Strings.Text_Buffers.Put (S, Image (V));
end Put_Image;
-----------
diff --git a/gcc/ada/libgnat/s-rannum.ads b/gcc/ada/libgnat/s-rannum.ads
index 370a07989b9..99ed57daadd 100644
--- a/gcc/ada/libgnat/s-rannum.ads
+++ b/gcc/ada/libgnat/s-rannum.ads
@@ -57,7 +57,7 @@
with Interfaces;
-private with Ada.Strings.Text_Output;
+private with Ada.Strings.Text_Buffers;
package System.Random_Numbers with
SPARK_Mode => Off
@@ -148,7 +148,7 @@ private
type State is array (0 .. N - 1) of State_Val with Put_Image => Put_Image;
procedure Put_Image
- (S : in out Ada.Strings.Text_Output.Sink'Class; V : State);
+ (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : State);
type Writable_Access (Self : access Generator) is limited null record;
-- Auxiliary type to make Generator a self-referential type
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 175bc1413b3..6fe6f8567ac 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -574,10 +574,11 @@ package body Rtsfind is
range Ada_Streams_Stream_IO .. Ada_Streams_Stream_IO;
subtype Ada_Strings_Descendant is Ada_Descendant
- range Ada_Strings_Superbounded .. Ada_Strings_Text_Output_Buffers;
+ range Ada_Strings_Superbounded .. Ada_Strings_Text_Buffers_Unbounded;
- subtype Ada_Strings_Text_Output_Descendant is Ada_Strings_Descendant
- range Ada_Strings_Text_Output_Utils .. Ada_Strings_Text_Output_Buffers;
+ subtype Ada_Strings_Text_Buffers_Descendant is Ada_Strings_Descendant
+ range Ada_Strings_Text_Buffers_Unbounded ..
+ Ada_Strings_Text_Buffers_Unbounded;
subtype Ada_Text_IO_Descendant is Ada_Descendant
range Ada_Text_IO_Decimal_IO .. Ada_Text_IO_Modular_IO;
@@ -661,8 +662,8 @@ package body Rtsfind is
elsif U_Id in Ada_Strings_Descendant then
Name_Buffer (12) := '.';
- if U_Id in Ada_Strings_Text_Output_Descendant then
- Name_Buffer (24) := '.';
+ if U_Id in Ada_Strings_Text_Buffers_Descendant then
+ Name_Buffer (25) := '.';
end if;
elsif U_Id in Ada_Text_IO_Descendant then
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 36e0440c868..df51477c139 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -126,12 +126,11 @@ package Rtsfind is
Ada_Strings_Wide_Superbounded,
Ada_Strings_Wide_Wide_Superbounded,
Ada_Strings_Unbounded,
- Ada_Strings_Text_Output,
+ Ada_Strings_Text_Buffers,
- -- Children of Ada.Strings.Text_Output
+ -- Children of Ada.Strings.Text_Buffers
- Ada_Strings_Text_Output_Utils,
- Ada_Strings_Text_Output_Buffers,
+ Ada_Strings_Text_Buffers_Unbounded,
-- Children of Ada.Text_IO (for Check_Text_IO_Special_Unit)
@@ -604,15 +603,14 @@ package Rtsfind is
RE_Unbounded_String, -- Ada.Strings.Unbounded
- RE_Sink, -- Ada.Strings.Text_Output
+ RE_Root_Buffer_Type, -- Ada.Strings.Text_Buffers
+ RE_Put_UTF_8, -- Ada.Strings.Text_Buffers
+ RE_Wide_Wide_Put, -- Ada.Strings.Text_Buffers
- RE_Put_UTF_8, -- Ada.Strings.Text_Output.Utils
- RE_Put_Wide_Wide_String, -- Ada.Strings.Text_Output.Utils
-
- RE_Buffer, -- Ada.Strings.Text_Output.Buffers
- RE_New_Buffer, -- Ada.Strings.Text_Output.Buffers
- RE_Destroy, -- Ada.Strings.Text_Output.Buffers
- RE_Get, -- Ada.Strings.Text_Output.Buffers
+ RE_Buffer_Type, -- Ada.Strings.Text_Buffers.Unbounded
+ RE_Get, -- Ada.Strings.Text_Buffers.Unbounded
+ RE_Wide_Get, -- Ada.Strings.Text_Buffers.Unbounded
+ RE_Wide_Wide_Get, -- Ada.Strings.Text_Buffers.Unbounded
RE_Wait_For_Release, -- Ada.Synchronous_Barriers
@@ -2286,15 +2284,14 @@ package Rtsfind is
RE_Unbounded_String => Ada_Strings_Unbounded,
- RE_Sink => Ada_Strings_Text_Output,
-
- RE_Put_UTF_8 => Ada_Strings_Text_Output_Utils,
- RE_Put_Wide_Wide_String => Ada_Strings_Text_Output_Utils,
+ RE_Root_Buffer_Type => Ada_Strings_Text_Buffers,
+ RE_Put_UTF_8 => Ada_Strings_Text_Buffers,
+ RE_Wide_Wide_Put => Ada_Strings_Text_Buffers,
- RE_Buffer => Ada_Strings_Text_Output_Buffers,
- RE_New_Buffer => Ada_Strings_Text_Output_Buffers,
- RE_Destroy => Ada_Strings_Text_Output_Buffers,
- RE_Get => Ada_Strings_Text_Output_Buffers,
+ RE_Buffer_Type => Ada_Strings_Text_Buffers_Unbounded,
+ RE_Get => Ada_Strings_Text_Buffers_Unbounded,
+ RE_Wide_Get => Ada_Strings_Text_Buffers_Unbounded,
+ RE_Wide_Wide_Get => Ada_Strings_Text_Buffers_Unbounded,
RE_Wait_For_Release => Ada_Synchronous_Barriers,
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index b23ee09020e..b7297e5edfd 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2432,15 +2432,18 @@ package body Sem_Attr is
Analyze_And_Resolve (E1);
-- Check that the first argument is
- -- Ada.Strings.Text_Output.Sink'Class.
+ -- Ada.Strings.Text_Buffers.Root_Buffer_Type'Class.
-- Note: the double call to Root_Type here is needed because the
-- root type of a class-wide type is the corresponding type (e.g.
-- X for X'Class, and we really want to go to the root.)
- if not Is_RTE (Root_Type (Root_Type (Etype (E1))), RE_Sink) then
+ if not Is_RTE (Root_Type (Root_Type (Etype (E1))),
+ RE_Root_Buffer_Type)
+ then
Error_Attr
- ("expected Ada.Strings.Text_Output.Sink''Class", E1);
+ ("expected Ada.Strings.Text_Buffers.Root_Buffer_Type''Class",
+ E1);
end if;
-- Check that the second argument is of the right type
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 9ec584439b9..1e7b93cc5b5 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -626,7 +626,7 @@ package body Sem_Ch10 is
-- Start of processing for Analyze_Compilation_Unit
begin
- Exp_Put_Image.Preload_Sink (N);
+ Exp_Put_Image.Preload_Root_Buffer_Type (N);
Process_Compilation_Unit_Pragmas (N);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 062aa50017a..cfcbe148498 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5230,7 +5230,9 @@ package body Sem_Ch13 is
F := First_Formal (Subp);
- if No (F) or else Etype (F) /= Class_Wide_Type (RTE (RE_Sink)) then
+ if No (F)
+ or else Etype (F) /= Class_Wide_Type (RTE (RE_Root_Buffer_Type))
+ then
return False;
end if;
@@ -14171,7 +14173,7 @@ package body Sem_Ch13 is
begin
Subp_Id := Make_Defining_Identifier (Loc, Sname);
- -- S : Sink'Class
+ -- S : Root_Buffer_Type'Class
Formals := New_List (
Make_Parameter_Specification (Loc,
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-06-21 11:06 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-06-21 11:06 [gcc r12-1692] [Ada] Add Ada.Strings.Text_Buffers and replace uses of Ada.Strings.Text_Output 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).