diff options
| author | Steve Baird <baird@adacore.com> | 2021-03-29 17:09:31 -0700 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-06-21 06:45:17 -0400 |
| commit | 20922782976048592eb9240ad2ab8690b207dc24 (patch) | |
| tree | 748250705a37e2de4446058ca5a8e2bf0cf2c5d4 | |
| parent | 88bed4e088a197e89051b520da8bb3631a10f9c0 (diff) | |
| download | gcc-20922782976048592eb9240ad2ab8690b207dc24.tar.gz | |
[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.
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, |