From 76f9c7f44fffb0b03266730b137313fe79f1c99e Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 3 Feb 2021 05:31:16 -0500 Subject: [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. --- gcc/ada/sinfo-utils.adb | 217 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 217 insertions(+) create mode 100644 gcc/ada/sinfo-utils.adb (limited to 'gcc/ada/sinfo-utils.adb') 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; -- cgit v1.1 From 1e4b06a8ec0db86e8398b8e9f4a98c8950bbd24f Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Tue, 23 Feb 2021 10:31:45 -0500 Subject: [Ada] Restore nnd capability gcc/ada/ * atree.adb: Move nnd-related code from here, and leave a comment pointing to sinfo-utils.adb. * sinfo-utils.ads, sinfo-utils.adb: Move nnd-related code to here. --- gcc/ada/sinfo-utils.adb | 109 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 109 insertions(+) (limited to 'gcc/ada/sinfo-utils.adb') diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb index abcda46..b066461 100644 --- a/gcc/ada/sinfo-utils.adb +++ b/gcc/ada/sinfo-utils.adb @@ -24,10 +24,119 @@ ------------------------------------------------------------------------------ with Atree; +with Debug; use Debug; +with Output; use Output; with Seinfo; +with Sinput; use Sinput; package body Sinfo.Utils is + --------------- + -- Debugging -- + --------------- + + -- Suppose you find that node 12345 is messed up. You might want to find + -- the code that created that node. There are two ways to do this: + + -- One way is to set a conditional breakpoint on New_Node_Debugging_Output + -- (nickname "nnd"): + -- break nnd if n = 12345 + -- and run gnat1 again from the beginning. + + -- The other way is to set a breakpoint near the beginning (e.g. on + -- gnat1drv), and run. Then set Watch_Node (nickname "ww") to 12345 in gdb: + -- ww := 12345 + -- and set a breakpoint on New_Node_Breakpoint (nickname "nn"). Continue. + + -- Either way, gnat1 will stop when node 12345 is created, or certain other + -- interesting operations are performed, such as Rewrite. To see exactly + -- which operations, search for "pragma Debug" below. + + -- The second method is much faster if the amount of Ada code being + -- compiled is large. + + ww : Node_Id'Base := Node_Id'First - 1; + pragma Export (Ada, ww); + Watch_Node : Node_Id'Base renames ww; + -- Node to "watch"; that is, whenever a node is created, we check if it + -- is equal to Watch_Node, and if so, call New_Node_Breakpoint. You have + -- presumably set a breakpoint on New_Node_Breakpoint. Note that the + -- initial value of Node_Id'First - 1 ensures that by default, no node + -- will be equal to Watch_Node. + + procedure nn; + pragma Export (Ada, nn); + procedure New_Node_Breakpoint renames nn; + -- This doesn't do anything interesting; it's just for setting breakpoint + -- on as explained above. + + procedure nnd (N : Node_Id); + pragma Export (Ada, nnd); + -- For debugging. If debugging is turned on, New_Node and New_Entity call + -- this. If debug flag N is turned on, this prints out the new node. + -- + -- If Node = Watch_Node, this prints out the new node and calls + -- New_Node_Breakpoint. Otherwise, does nothing. + + procedure Node_Debug_Output (Op : String; N : Node_Id); + -- Called by nnd; writes Op followed by information about N + + ------------------------- + -- New_Node_Breakpoint -- + ------------------------- + + procedure nn is + begin + Write_Str ("Watched node "); + Write_Int (Int (Watch_Node)); + Write_Eol; + end nn; + + ------------------------------- + -- New_Node_Debugging_Output -- + ------------------------------- + + procedure nnd (N : Node_Id) is + Node_Is_Watched : constant Boolean := N = Watch_Node; + + begin + if Debug_Flag_N or else Node_Is_Watched then + Node_Debug_Output ("Node", N); + + if Node_Is_Watched then + New_Node_Breakpoint; + end if; + end if; + end nnd; + + procedure New_Node_Debugging_Output (N : Node_Id) is + begin + pragma Debug (nnd (N)); + end New_Node_Debugging_Output; + + ----------------------- + -- Node_Debug_Output -- + ----------------------- + + procedure Node_Debug_Output (Op : String; N : Node_Id) is + begin + Write_Str (Op); + + if Nkind (N) in N_Entity then + Write_Str (" entity"); + else + Write_Str (" node"); + end if; + + Write_Str (" Id = "); + Write_Int (Int (N)); + Write_Str (" "); + Write_Location (Sloc (N)); + Write_Str (" "); + Write_Str (Node_Kind'Image (Nkind (N))); + Write_Eol; + end Node_Debug_Output; + ------------------------- -- Iterator Procedures -- ------------------------- -- cgit v1.1 From f54fb769ec25976858e6bdea9c6a1beeb70f91fa Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 3 Mar 2021 16:12:54 -0500 Subject: [Ada] Fix varsize node name conflict gcc/ada/ * gen_il-gen.adb, gen_il-internals.ads: Generate field enumeration literals with "F_" prefix. Update all generated references accordingly. * atree.adb, einfo-utils.adb, sem_ch3.adb, sem_ch5.adb, sem_ch6.adb, sem_ch8.adb, sinfo-cn.adb, sinfo-utils.adb, sinfo-utils.ads, treepr.adb: Add "F_" prefix to all uses of the field enumeration literals. --- gcc/ada/sinfo-utils.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/ada/sinfo-utils.adb') diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb index b066461..f9db669 100644 --- a/gcc/ada/sinfo-utils.adb +++ b/gcc/ada/sinfo-utils.adb @@ -239,7 +239,7 @@ package body Sinfo.Utils is begin for J in Fields'Range loop - if Fields (J) /= Link then -- Don't walk Parent! + if Fields (J) /= F_Link then -- Don't walk Parent! declare Desc : Field_Descriptor renames Node_Field_Descriptors (Fields (J)); @@ -264,7 +264,7 @@ package body Sinfo.Utils is begin for J in Fields'Range loop - if Fields (J) /= Link then -- Don't walk Parent! + if Fields (J) /= F_Link then -- Don't walk Parent! declare Desc : Field_Descriptor renames Node_Field_Descriptors (Fields (J)); -- cgit v1.1 From 898edf758e03a6cc31219405a667c75b67a726ca Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 9 Apr 2021 14:53:56 -0400 Subject: [Ada] tech debt: Parent (Empty) is not allowed gcc/ada/ * atree.adb, atree.ads (Parent, Set_Parent): Assert node is Present. (Copy_Parent, Parent_Kind): New helper routines. * gen_il-gen.adb: Add with clause. * nlists.adb (Parent): Assert Parent of list is Present. * aspects.adb, checks.adb, exp_aggr.adb, exp_ch6.adb, exp_util.adb, lib-xref-spark_specific.adb, osint.ads, sem_ch12.adb, sem_ch13.adb, sem_ch3.adb, sem_ch6.adb, sem_dim.adb, sem_prag.adb, sem_res.adb, sem_util.adb, treepr.adb: Do not call Parent and Set_Parent on the Empty node. * libgnat/a-stwiun__shared.adb, libgnat/a-stzunb__shared.adb: Minor: Fix typos in comments. * einfo.ads: Minor comment update. * sinfo-utils.ads, sinfo-utils.adb (Parent_Kind, Copy_Parent): New functions. --- gcc/ada/sinfo-utils.adb | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) (limited to 'gcc/ada/sinfo-utils.adb') diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb index f9db669..7f9bb89 100644 --- a/gcc/ada/sinfo-utils.adb +++ b/gcc/ada/sinfo-utils.adb @@ -137,6 +137,29 @@ package body Sinfo.Utils is Write_Eol; end Node_Debug_Output; + ------------------------------- + -- Parent-related operations -- + ------------------------------- + + procedure Copy_Parent (To, From : Node_Or_Entity_Id) is + begin + if Atree.Present (To) and Atree.Present (From) then + Atree.Set_Parent (To, Atree.Parent (From)); + else + pragma Assert + (if Atree.Present (To) then Atree.No (Atree.Parent (To))); + end if; + end Copy_Parent; + + function Parent_Kind (N : Node_Id) return Node_Kind is + begin + if Atree.No (N) then + return N_Empty; + else + return Nkind (Atree.Parent (N)); + end if; + end Parent_Kind; + ------------------------- -- Iterator Procedures -- ------------------------- -- cgit v1.1