[Ada] Variable-sized node types

gcc/ada/

	* atree.ads, atree.adb: Major rewrite to support variable-sized
	node types. Add pragmas Suppress and Assertion_Policy.  We now
	have an extra level of indirection: Node_Offsets is a table
	mapping Node_Ids to the offset of the start of each node in
	Slots. Slots is a table containing one or more contiguous slots
	for each node. Each slot is a 32-bit unchecked union that can
	contain any mixture of 1, 2, 4, 8, and 32-bit fields that fits.
	The old low-level getters and setters (e.g.  Flag123) are
	removed.
	* gen_il-fields.ads, gen_il-gen-gen_entities.adb,
	gen_il-gen-gen_nodes.adb, gen_il-gen.adb, gen_il-gen.ads,
	gen_il-main.adb, gen_il-types.ads, gen_il-utils.adb,
	gen_il-utils.ads, gen_il.adb, gen_il.ads: New gen_il program
	that generates various Ada and C++ files. In particular, the
	following files are generated by gen_il: einfo-entities.adb
	einfo-entities.ads, gnatvsn.ads, nmake.adb, nmake.ads,
	seinfo.ads, seinfo_tables.adb, seinfo_tables.ads,
	sinfo-nodes.adb, sinfo-nodes.ads, einfo.h, and sinfo.h.
	* sinfo-utils.adb, sinfo-utils.ads, einfo-utils.adb,
	einfo-utils.ads: New files containing code that needs to refer
	to Sinfo.Nodes and Einfo.Entities. This code is mostly moved
	here from Sinfo and Einfo to break cycles.
	* back_end.adb: Pass node_offsets_ptr and slots_ptr to gigi,
	instead of nodes_ptr and flags_ptr. The Nodes and Flags tables
	no longer exist. (Note that gigi never used the Flags table.)
	* sinfo-cn.ads (Change_Identifier_To_Defining_Identifier,
	Change_Character_Literal_To_Defining_Character_Literal,
	Change_Operator_Symbol_To_Defining_Operator_Symbol): Turn N into
	an IN formal.
	* sinfo-cn.adb: Update.  Add assertions, which can be removed at
	some point.  Rewrite to use higher-level facilities.  Make sure
	vanishing fields are zeroed out.  Add with/use for new packages.
	* sem_util.adb: Remove "Assert(False)" immediately followed by
	"raise Program_Error".  Use higher-level facilities such as
	Walk_Sinfo_Fields instead of depending on low-level Set_FieldN
	routines that no longer exist. Use Get_Comes_From_Source_Default
	instead of Default_Node.Comes_From_Source (Default_Node no
	longer exists).  Use Set_Basic_Convention instead of
	Basic_Set_Convention.  Add with/use for new packages.
	* sem_util.ads: The Convention field had getter Convention and
	setter Basic_Set_Convention. Make that more uniform: there is
	now a field called Basic_Convention, with Basic_Convention and
	Set_Basic_Convention as getter/setter, and write Convention and
	Set_Convention here.
	* nlists.adb: Rewrite to use abstractions, rather then depending
	on low-level implementation details of Atree. Necessary because
	those details have changed. Add with/use for new packages.
	* sem_ch12.adb: Use higher-level facilities such as
	Walk_Sinfo_Fields instead of depending on low-level Set_FieldN
	routines that no longer exist. Add with/use for new packages.
	* exp_cg.adb, sem_ch10.adb, sem_ch4.adb, sem_eval.adb,
	sem_prag.adb, sem_warn.adb: Change expanded names to refer to
	the new packages for things that moved. Add with/use for new
	packages.
	* sem_ch3.adb: Likewise. Reinitialize vanishing fields.
	* exp_disp.adb: Likewise. Remove failing assertion.
	* sinfo.ads, einfo.ads: Remove code that is now generated into
	Sinfo.Nodes and Einfo.Entities.
	* sinfo.adb, einfo.adb: Replace bodies with "pragma No_Body;".
	We should delete these at some point, but No_Body makes make
	files easier. Some code is moved to Sinfo.Nodes, Einfo.Entities,
	Sinfo.Utils, and Einfo.Utils. Some is no longer necessary.
	* treepr.adb: Rewrite to use new tables. We no longer need
	treeprs.ads.
	* treepr.ads: Add comment.
	* types.ads: Move types Component_Alignment_Kind and
	Float_Rep_Kind here.
	* atree.h: Major update to match atree.ads changes.  Add slot
	types, for use by getters/setters.
	* types.h: Move types Component_Alignment_Kind and
	Float_Rep_Kind here.
	* fe.h: Rewrite to deal with code that has changed or moved from
	Atree, Sinfo, Einfo.
	* nlists.h: Move some code to fe.h.
	* alloc.ads: Split Nodes_* constants into Node_Offsets and
	Slots, because Atree has two separate tables.  Increase values.
	Remove Nodes_Release_Threshold. Improve comment.
	* debug.adb, gnat1drv.adb: Remove obsolete gnatd.A and gnatd.N
	switches.  Add with/use for new packages.
	* opt.ads: Minor comment fix.
	* aspects.adb, checks.adb, comperr.adb, contracts.adb,
	cstand.adb, debug_a.adb, errout.adb, eval_fat.adb, exp_aggr.adb,
	exp_atag.adb, exp_attr.adb, exp_ch11.adb, exp_ch12.adb,
	exp_ch13.adb, exp_ch2.adb, exp_ch3.adb, exp_ch4.adb,
	exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch8.adb, exp_ch9.adb,
	exp_code.adb, exp_dbug.adb, exp_dist.adb, exp_fixd.adb,
	exp_imgv.adb, exp_intr.adb, exp_pakd.adb, exp_prag.adb,
	exp_put_image.adb, exp_sel.adb, exp_smem.adb, exp_spark.adb,
	exp_strm.adb, exp_tss.adb, exp_unst.adb, exp_util.adb,
	exp_util.ads, expander.adb, freeze.adb, frontend.adb,
	get_targ.ads, ghost.adb, gnat_cuda.adb, impunit.adb, inline.adb,
	itypes.adb, itypes.ads, layout.adb, lib.adb, lib-load.adb,
	lib-writ.adb, lib-xref.adb, lib-xref.ads,
	lib-xref-spark_specific.adb, live.adb, par.adb, par_sco.adb,
	pprint.adb, repinfo.adb, restrict.adb, rtsfind.adb, scil_ll.adb,
	scn.adb, sem.adb, sem.ads, sem_aggr.adb, sem_attr.adb,
	sem_aux.adb, sem_case.adb, sem_cat.adb, sem_ch11.adb,
	sem_ch13.adb, sem_ch2.adb, sem_ch5.adb, sem_ch6.adb,
	sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_dim.adb,
	sem_disp.adb, sem_dist.adb, sem_elab.adb, sem_elim.adb,
	sem_intr.adb, sem_mech.adb, sem_res.adb, sem_scil.adb,
	sem_smem.adb, sem_type.adb, set_targ.ads, sinput.adb,
	sinput-l.adb, sprint.adb, style.adb, styleg.adb, tbuild.adb,
	tbuild.ads, uname.adb: Add with/use for new packages.
	* libgnat/a-stoubu.adb, libgnat/a-stouut.adb: Simplify to ease
	bootstrap.
	* libgnat/a-stobfi.adb, libgnat/a-stoufi.adb (Create_File,
	Create_New_File): Create file in binary format, to avoid
	introducing unwanted text conversions on Windows. Simplify to
	ease bootstrap.
	* libgnat/a-stteou__bootstrap.ads: New.
	* ceinfo.adb, csinfo.adb, nmake.adt, treeprs.adt, xeinfo.adb,
	xnmake.adb, xsinfo.adb, xtreeprs.adb: Delete.
	* Make-generated.in: Build and run the gen_il program to
	generate files. The files are generated in the ada/gen_il
	subdirectory, and then moved up to ada.  We rely on gnatmake (as
	opposed to make) to build the gen_il program efficiently (i.e.
	don't do anything if the sources didn't change).
	* gcc-interface/Makefile.in (ADAFLAGS): Add -gnatU.
	(GNATMAKE_OBJS): Add new object files.
	(GENERATED_FILES_FOR_TOOLS): New variable.
	(../stamp-tools): Create a link for all
	GENERATED_FILES_FOR_TOOLS.
	* gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Add new object
	files.  Remove ada/treeprs.o.
	(GNATBIND_OBJS): Add new object files.
	(ada.mostlyclean): Remove ada/sdefault.adb and add
	ada/stamp-gen_il.
	(ada.maintainer-clean): Remove ada/treeprs.ads.
	(update-sources): Remove obsolete target.
	(ada_generated_files): Rename to...
	(ADA_GENERATED_FILES): ... this.  Add new source files.  Add
	comment.

	* gcc-interface/trans.c: Remove obsolete Nodes_Ptr and
	Flags_ptr.  Add Node_Offsets_Ptr and Slots_Ptr, which point to
	the corresponding tables in Atree.
	* gcc-interface/gigi.h (gigi): New parameters for initializing
	Node_Offsets_Ptr and Slots_Ptr.
	* gcc-interface/decl.c: Numeric_Kind,
	Discrete_Or_Fixed_Point_Kind, and Record_Kind were
	nonhierarchical, and were therefore removed for simplicity.
	Replace uses with calls to Is_In_... functions.

gnattools/

	* Makefile.in (GENERATED_FILES_FOR_TOOLS): New variable.
	($(GCC_DIR)/stamp-tools): Walk it for the first copy operation.

1 files changed, 217 insertions, 0 deletions

diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb
new file mode 100644
index 0000000..abcda46
--- /dev/null
+++ b/gcc/ada/sinfo-utils.adb
@@ -0,0 +1,217 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                           S I N F O . U T I L S                          --
+--                                                                          --
+--                                 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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;
+with Seinfo;
+
+package body Sinfo.Utils is
+
+   -------------------------
+   -- Iterator Procedures --
+   -------------------------
+
+   procedure Next_Entity       (N : in out Node_Id) is
+   begin
+      N := Next_Entity (N);
+   end Next_Entity;
+
+   procedure Next_Named_Actual (N : in out Node_Id) is
+   begin
+      N := Next_Named_Actual (N);
+   end Next_Named_Actual;
+
+   procedure Next_Rep_Item     (N : in out Node_Id) is
+   begin
+      N := Next_Rep_Item (N);
+   end Next_Rep_Item;
+
+   procedure Next_Use_Clause   (N : in out Node_Id) is
+   begin
+      N := Next_Use_Clause (N);
+   end Next_Use_Clause;
+
+   ------------------
+   -- End_Location --
+   ------------------
+
+   function End_Location (N : Node_Id) return Source_Ptr is
+      L : constant Uint := End_Span (N);
+   begin
+      if L = No_Uint then
+         return No_Location;
+      else
+         return Source_Ptr (Int (Sloc (N)) + UI_To_Int (L));
+      end if;
+   end End_Location;
+
+   --------------------
+   -- Get_Pragma_Arg --
+   --------------------
+
+   function Get_Pragma_Arg (Arg : Node_Id) return Node_Id is
+   begin
+      if Nkind (Arg) = N_Pragma_Argument_Association then
+         return Expression (Arg);
+      else
+         return Arg;
+      end if;
+   end Get_Pragma_Arg;
+
+   ----------------------
+   -- Set_End_Location --
+   ----------------------
+
+   procedure Set_End_Location (N : Node_Id; S : Source_Ptr) is
+   begin
+      Set_End_Span (N,
+        UI_From_Int (Int (S) - Int (Sloc (N))));
+   end Set_End_Location;
+
+   --------------------------
+   -- Pragma_Name_Unmapped --
+   --------------------------
+
+   function Pragma_Name_Unmapped (N : Node_Id) return Name_Id is
+   begin
+      return Chars (Pragma_Identifier (N));
+   end Pragma_Name_Unmapped;
+
+   ------------------------------------
+   -- Helpers for Walk_Sinfo_Fields* --
+   ------------------------------------
+
+   function Get_Node_Field_Union is new
+     Atree.Atree_Private_Part.Get_32_Bit_Field (Union_Id) with Inline;
+   procedure Set_Node_Field_Union is new
+     Atree.Atree_Private_Part.Set_32_Bit_Field (Union_Id) with Inline;
+
+   use Seinfo;
+
+   function Is_In_Union_Id (F_Kind : Field_Kind) return Boolean is
+     (F_Kind in Node_Id_Field
+              | List_Id_Field
+              | Elist_Id_Field
+              | Name_Id_Field
+              | String_Id_Field
+              | Uint_Field
+              | Ureal_Field
+              | Union_Id_Field);
+   --  True if the field type is one that can be converted to Types.Union_Id
+
+   -----------------------
+   -- Walk_Sinfo_Fields --
+   -----------------------
+
+   procedure Walk_Sinfo_Fields (N : Node_Id) is
+      Fields : Node_Field_Array renames
+        Node_Field_Table (Nkind (N)).all;
+
+   begin
+      for J in Fields'Range loop
+         if Fields (J) /= Link then -- Don't walk Parent!
+            declare
+               Desc : Field_Descriptor renames
+                 Node_Field_Descriptors (Fields (J));
+            begin
+               if Is_In_Union_Id (Desc.Kind) then
+                  Action (Get_Node_Field_Union (N, Desc.Offset));
+               end if;
+            end;
+         end if;
+      end loop;
+   end Walk_Sinfo_Fields;
+
+   --------------------------------
+   -- Walk_Sinfo_Fields_Pairwise --
+   --------------------------------
+
+   procedure Walk_Sinfo_Fields_Pairwise (N1, N2 : Node_Id) is
+      pragma Assert (Nkind (N1) = Nkind (N2));
+
+      Fields : Node_Field_Array renames
+        Node_Field_Table (Nkind (N1)).all;
+
+   begin
+      for J in Fields'Range loop
+         if Fields (J) /= Link then -- Don't walk Parent!
+            declare
+               Desc : Field_Descriptor renames
+                 Node_Field_Descriptors (Fields (J));
+            begin
+               if Is_In_Union_Id (Desc.Kind) then
+                  Set_Node_Field_Union
+                    (N1, Desc.Offset,
+                     Transform (Get_Node_Field_Union (N2, Desc.Offset)));
+               end if;
+            end;
+         end if;
+      end loop;
+   end Walk_Sinfo_Fields_Pairwise;
+
+   ---------------------
+   -- Map_Pragma_Name --
+   ---------------------
+
+   --  We don't want to introduce a dependence on some hash table package or
+   --  similar, so we use a simple array of Key => Value pairs, and do a linear
+   --  search. Linear search is plenty efficient, given that we don't expect
+   --  more than a couple of entries in the mapping.
+
+   type Name_Pair is record
+      Key   : Name_Id;
+      Value : Name_Id;
+   end record;
+
+   type Pragma_Map_Index is range 1 .. 100;
+   Pragma_Map : array (Pragma_Map_Index) of Name_Pair;
+   Last_Pair : Pragma_Map_Index'Base range 0 .. Pragma_Map_Index'Last := 0;
+
+   procedure Map_Pragma_Name (From, To : Name_Id) is
+   begin
+      if Last_Pair = Pragma_Map'Last then
+         raise Too_Many_Pragma_Mappings;
+      end if;
+
+      Last_Pair := Last_Pair + 1;
+      Pragma_Map (Last_Pair) := (Key => From, Value => To);
+   end Map_Pragma_Name;
+
+   -----------------
+   -- Pragma_Name --
+   -----------------
+
+   function Pragma_Name (N : Node_Id) return Name_Id is
+      Result : constant Name_Id := Pragma_Name_Unmapped (N);
+   begin
+      for J in Pragma_Map'First .. Last_Pair loop
+         if Result = Pragma_Map (J).Key then
+            return Pragma_Map (J).Value;
+         end if;
+      end loop;
+
+      return Result;
+   end Pragma_Name;
+
+end Sinfo.Utils;