diff options
| author | Bob Duff <duff@adacore.com> | 2021-02-03 05:31:16 -0500 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-05-07 05:29:09 -0400 |
| commit | 76f9c7f44fffb0b03266730b137313fe79f1c99e (patch) | |
| tree | 8c77fa6bd5661f0ffb427f7003a21b9a46dc30d6 | |
| parent | 476ed6bf66ab20e22ae4b3da0fd7fd94753f2334 (diff) | |
| download | gcc-76f9c7f44fffb0b03266730b137313fe79f1c99e.tar.gz | |
[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.
167 files changed, 17808 insertions, 43315 deletions
diff --git a/gcc/ada/Make-generated.in b/gcc/ada/Make-generated.in index 757eaa85b90..237444c7a26 100644 --- a/gcc/ada/Make-generated.in +++ b/gcc/ada/Make-generated.in @@ -2,10 +2,6 @@ # Note: can't use ?= here, not supported by older versions of GNU Make -ifeq ($(origin ADA_GEN_SUBDIR), undefined) -ADA_GEN_SUBDIR=ada -endif - ifeq ($(origin CP), undefined) CP=cp endif @@ -14,60 +10,84 @@ ifeq ($(origin MKDIR), undefined) MKDIR=mkdir -p endif -ifeq ($(origin MOVE_IF_CHANGE), undefined) -MOVE_IF_CHANGE=mv -f -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) + +.PHONY: do_gen_il +do_gen_il: + $(MKDIR) ada/gen_il + $(MKDIR) ada/generated + # 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 + +ada/seinfo_tables.ads: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/seinfo_tables.ads ada/seinfo_tables.ads + +ada/seinfo_tables.adb: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/seinfo_tables.adb ada/seinfo_tables.adb + +# We need -gnatX to compile seinfo_tables, because it uses extensions. This +# target is not currently used when building gnat, because these extensions +# would cause bootstrapping with older compilers to fail. You can call it by +# hand, as a sanity check that these files are legal. +ada/seinfo_tables.o: ada/seinfo_tables.ads ada/seinfo_tables.adb + cd ada ; time gnatmake $(GEN_IL_INCLUDES) seinfo_tables.adb -gnatU -gnatX + +ada/sinfo.h: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/sinfo.h ada/sinfo.h + +ada/einfo.h: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/einfo.h ada/einfo.h + +ada/nmake.ads: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/nmake.ads ada/nmake.ads + $(CP) ada/nmake.ads ada/generated + +ada/nmake.adb: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/nmake.adb ada/nmake.adb + $(CP) ada/nmake.adb ada/generated + +ada/seinfo.ads: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/seinfo.ads ada/seinfo.ads + $(CP) ada/seinfo.ads ada/generated + +ada/sinfo-nodes.ads: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/sinfo-nodes.ads ada/sinfo-nodes.ads + $(CP) ada/sinfo-nodes.ads ada/generated + +ada/sinfo-nodes.adb: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/sinfo-nodes.adb ada/sinfo-nodes.adb + $(CP) ada/sinfo-nodes.adb ada/generated + +ada/einfo-entities.ads: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/einfo-entities.ads ada/einfo-entities.ads + $(CP) ada/einfo-entities.ads ada/generated + +ada/einfo-entities.adb: do_gen_il + $(fsrcdir)/../move-if-change ada/gen_il/einfo-entities.adb ada/einfo-entities.adb + $(CP) ada/einfo-entities.adb ada/generated + +ada/snames.h ada/snames.ads ada/snames.adb : ada/stamp-snames ; @true +ada/stamp-snames : ada/snames.ads-tmpl ada/snames.adb-tmpl ada/snames.h-tmpl ada/xsnamest.adb ada/xutil.ads ada/xutil.adb + -$(MKDIR) ada/bldtools/snamest + $(RM) $(addprefix ada/bldtools/snamest/,$(notdir $^)) + $(CP) $^ ada/bldtools/snamest + cd ada/bldtools/snamest; gnatmake -q xsnamest ; ./xsnamest + $(fsrcdir)/../move-if-change ada/bldtools/snamest/snames.ns ada/snames.ads + $(fsrcdir)/../move-if-change ada/bldtools/snamest/snames.nb ada/snames.adb + $(fsrcdir)/../move-if-change ada/bldtools/snamest/snames.nh ada/snames.h + touch ada/stamp-snames -.PHONY: ada_extra_files -ada_extra_files : $(ADA_GEN_SUBDIR)/treeprs.ads $(ADA_GEN_SUBDIR)/einfo.h $(ADA_GEN_SUBDIR)/sinfo.h $(ADA_GEN_SUBDIR)/nmake.adb \ - $(ADA_GEN_SUBDIR)/nmake.ads $(ADA_GEN_SUBDIR)/snames.ads $(ADA_GEN_SUBDIR)/snames.adb $(ADA_GEN_SUBDIR)/snames.h - -# We delete the files before copying, below, in case they are read-only. - -$(ADA_GEN_SUBDIR)/treeprs.ads : $(ADA_GEN_SUBDIR)/treeprs.adt $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/xtreeprs.adb - -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/treeprs - $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/treeprs/,$(notdir $^)) - $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/treeprs - (cd $(ADA_GEN_SUBDIR)/bldtools/treeprs; gnatmake -q xtreeprs ; ./xtreeprs treeprs.ads ) - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/treeprs/treeprs.ads $(ADA_GEN_SUBDIR)/treeprs.ads - -$(ADA_GEN_SUBDIR)/einfo.h : $(ADA_GEN_SUBDIR)/einfo.ads $(ADA_GEN_SUBDIR)/einfo.adb $(ADA_GEN_SUBDIR)/xeinfo.adb $(ADA_GEN_SUBDIR)/ceinfo.adb - -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/einfo - $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/einfo/,$(notdir $^)) - $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/einfo - (cd $(ADA_GEN_SUBDIR)/bldtools/einfo; gnatmake -q xeinfo ; ./xeinfo einfo.h ) - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/einfo/einfo.h $(ADA_GEN_SUBDIR)/einfo.h - -$(ADA_GEN_SUBDIR)/sinfo.h : $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/sinfo.adb $(ADA_GEN_SUBDIR)/xsinfo.adb $(ADA_GEN_SUBDIR)/csinfo.adb - -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/sinfo - $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/sinfo/,$(notdir $^)) - $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/sinfo - (cd $(ADA_GEN_SUBDIR)/bldtools/sinfo; gnatmake -q xsinfo ; ./xsinfo sinfo.h ) - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/sinfo/sinfo.h $(ADA_GEN_SUBDIR)/sinfo.h - -$(ADA_GEN_SUBDIR)/snames.h $(ADA_GEN_SUBDIR)/snames.ads $(ADA_GEN_SUBDIR)/snames.adb : $(ADA_GEN_SUBDIR)/stamp-snames ; @true -$(ADA_GEN_SUBDIR)/stamp-snames : $(ADA_GEN_SUBDIR)/snames.ads-tmpl $(ADA_GEN_SUBDIR)/snames.adb-tmpl $(ADA_GEN_SUBDIR)/snames.h-tmpl $(ADA_GEN_SUBDIR)/xsnamest.adb $(ADA_GEN_SUBDIR)/xutil.ads $(ADA_GEN_SUBDIR)/xutil.adb - -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/snamest - $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/snamest/,$(notdir $^)) - $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/snamest - (cd $(ADA_GEN_SUBDIR)/bldtools/snamest; gnatmake -q xsnamest ; ./xsnamest ) - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/snamest/snames.ns $(ADA_GEN_SUBDIR)/snames.ads - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/snamest/snames.nb $(ADA_GEN_SUBDIR)/snames.adb - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/snamest/snames.nh $(ADA_GEN_SUBDIR)/snames.h - touch $(ADA_GEN_SUBDIR)/stamp-snames - -$(ADA_GEN_SUBDIR)/nmake.adb $(ADA_GEN_SUBDIR)/nmake.ads: $(ADA_GEN_SUBDIR)/stamp-nmake ; @true -$(ADA_GEN_SUBDIR)/stamp-nmake: $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/nmake.adt $(ADA_GEN_SUBDIR)/xnmake.adb $(ADA_GEN_SUBDIR)/xutil.ads $(ADA_GEN_SUBDIR)/xutil.adb - -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/nmake - $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/nmake/,$(notdir $^)) - $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/nmake - (cd $(ADA_GEN_SUBDIR)/bldtools/nmake; gnatmake -q xnmake ; ./xnmake -b nmake.adb ; ./xnmake -s nmake.ads) - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/nmake/nmake.ads $(ADA_GEN_SUBDIR)/nmake.ads - $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/nmake/nmake.adb $(ADA_GEN_SUBDIR)/nmake.adb - touch $(ADA_GEN_SUBDIR)/stamp-nmake - -$(ADA_GEN_SUBDIR)/sdefault.adb: $(ADA_GEN_SUBDIR)/stamp-sdefault ; @true -$(ADA_GEN_SUBDIR)/stamp-sdefault : $(srcdir)/version.c Makefile +ada/sdefault.adb: ada/stamp-sdefault ; @true +ada/stamp-sdefault : $(srcdir)/version.c Makefile $(ECHO) "pragma Style_Checks (Off);" >tmp-sdefault.adb $(ECHO) "with Osint; use Osint;" >>tmp-sdefault.adb $(ECHO) "package body Sdefault is" >>tmp-sdefault.adb @@ -93,5 +113,5 @@ $(ADA_GEN_SUBDIR)/stamp-sdefault : $(srcdir)/version.c Makefile $(ECHO) " return Relocate_Path (S0, S4);" >>tmp-sdefault.adb $(ECHO) " end Search_Dir_Prefix;" >>tmp-sdefault.adb $(ECHO) "end Sdefault;" >> tmp-sdefault.adb - $(MOVE_IF_CHANGE) tmp-sdefault.adb $(ADA_GEN_SUBDIR)/sdefault.adb - touch $(ADA_GEN_SUBDIR)/stamp-sdefault + $(fsrcdir)/../move-if-change tmp-sdefault.adb ada/sdefault.adb + touch ada/stamp-sdefault diff --git a/gcc/ada/alloc.ads b/gcc/ada/alloc.ads index 13620f03294..85944c987cf 100644 --- a/gcc/ada/alloc.ads +++ b/gcc/ada/alloc.ads @@ -35,7 +35,7 @@ package Alloc is - -- The comment shows the unit in which the table is defined + -- The comment shows the unit in which the tables are defined All_Interp_Initial : constant := 1_000; -- Sem_Type All_Interp_Increment : constant := 100; @@ -94,9 +94,11 @@ package Alloc is Names_Initial : constant := 6_000; -- Namet Names_Increment : constant := 100; - Nodes_Initial : constant := 50_000; -- Atree - Nodes_Increment : constant := 100; - Nodes_Release_Threshold : constant := 100_000; + Node_Offsets_Initial : constant := 500_000; -- Atree, Nlists + Node_Offsets_Increment : constant := 100; + + Slots_Initial : constant := 2_000_000; -- Atree + Slots_Increment : constant := 100; Notes_Initial : constant := 100; -- Lib Notes_Increment : constant := 200; diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index e2b8ad430fe..2cdd219f1de 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -24,9 +24,13 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Nlists; use Nlists; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with GNAT.HTable; @@ -224,7 +228,7 @@ package body Aspects is while Present (Item) loop if Nkind (Item) = N_Aspect_Specification and then Get_Aspect_Id (Item) = A - and then Class_Present = Sinfo.Class_Present (Item) + and then Class_Present = Sinfo.Nodes.Class_Present (Item) then return Item; end if; @@ -248,7 +252,7 @@ package body Aspects is Spec := First (Aspect_Specifications (Decl)); while Present (Spec) loop if Get_Aspect_Id (Spec) = A - and then Class_Present = Sinfo.Class_Present (Spec) + and then Class_Present = Sinfo.Nodes.Class_Present (Spec) then return Spec; end if; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index e27209228ce..08b7d05c50b 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -23,21 +23,26 @@ -- -- ------------------------------------------------------------------------------ -pragma Style_Checks (All_Checks); --- Turn off subprogram ordering check for this package - -- WARNING: There is a C version of this package. Any changes to this source -- file must be properly reflected in the file atree.h which is a C header -- file containing equivalent definitions for use by gigi. -with Aspects; use Aspects; -with Debug; use Debug; -with Nlists; use Nlists; -with Opt; use Opt; -with Output; use Output; -with Sinput; use Sinput; +-- Checks and assertions in this package are too slow, and are mostly needed +-- when working on this package itself, or on gen_il, so we disable them. + +pragma Suppress (All_Checks); +pragma Assertion_Policy (Ignore); -with GNAT.Heap_Sort_G; +with Aspects; use Aspects; +with Debug; use Debug; +with Namet; use Namet; +with Nlists; use Nlists; +with Opt; use Opt; +with Output; use Output; +with Seinfo; use Seinfo; +with Sinfo.Utils; use Sinfo.Utils; +with Sinput; use Sinput; +with System.Storage_Elements; package body Atree is @@ -82,7 +87,7 @@ package body Atree is -- compiled is large. ww : Node_Id'Base := Node_Id'First - 1; - pragma Export (Ada, ww); -- trick the optimizer + 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 @@ -114,375 +119,9 @@ package body Atree is Comes_From_Source_Default : Boolean := False; - use Unchecked_Access; - -- We are allowed to see these from within our own body - use Atree_Private_Part; -- We are also allowed to see our private data structures - -- Functions used to store Entity_Kind value in Nkind field - - -- The following declarations are used to store flags 65-72 in the - -- Nkind field of the third component of an extended (entity) node. - - type Flag_Byte is record - Flag65 : Boolean; - Flag66 : Boolean; - Flag67 : Boolean; - Flag68 : Boolean; - Flag69 : Boolean; - Flag70 : Boolean; - Flag71 : Boolean; - Flag72 : Boolean; - end record; - - pragma Pack (Flag_Byte); - for Flag_Byte'Size use 8; - - type Flag_Byte_Ptr is access all Flag_Byte; - type Node_Kind_Ptr is access all Node_Kind; - - function To_Flag_Byte is new - Unchecked_Conversion (Node_Kind, Flag_Byte); - - function To_Flag_Byte_Ptr is new - Unchecked_Conversion (Node_Kind_Ptr, Flag_Byte_Ptr); - - -- The following declarations are used to store flags 239-246 in the - -- Nkind field of the fourth component of an extended (entity) node. - - type Flag_Byte2 is record - Flag239 : Boolean; - Flag240 : Boolean; - Flag241 : Boolean; - Flag242 : Boolean; - Flag243 : Boolean; - Flag244 : Boolean; - Flag245 : Boolean; - Flag246 : Boolean; - end record; - - pragma Pack (Flag_Byte2); - for Flag_Byte2'Size use 8; - - type Flag_Byte2_Ptr is access all Flag_Byte2; - - function To_Flag_Byte2 is new - Unchecked_Conversion (Node_Kind, Flag_Byte2); - - function To_Flag_Byte2_Ptr is new - Unchecked_Conversion (Node_Kind_Ptr, Flag_Byte2_Ptr); - - -- The following declarations are used to store flags 247-254 in the - -- Nkind field of the fifth component of an extended (entity) node. - - type Flag_Byte3 is record - Flag247 : Boolean; - Flag248 : Boolean; - Flag249 : Boolean; - Flag250 : Boolean; - Flag251 : Boolean; - Flag252 : Boolean; - Flag253 : Boolean; - Flag254 : Boolean; - end record; - - pragma Pack (Flag_Byte3); - for Flag_Byte3'Size use 8; - - type Flag_Byte3_Ptr is access all Flag_Byte3; - - function To_Flag_Byte3 is new - Unchecked_Conversion (Node_Kind, Flag_Byte3); - - function To_Flag_Byte3_Ptr is new - Unchecked_Conversion (Node_Kind_Ptr, Flag_Byte3_Ptr); - - -- The following declarations are used to store flags 310-317 in the - -- Nkind field of the sixth component of an extended (entity) node. - - type Flag_Byte4 is record - Flag310 : Boolean; - Flag311 : Boolean; - Flag312 : Boolean; - Flag313 : Boolean; - Flag314 : Boolean; - Flag315 : Boolean; - Flag316 : Boolean; - Flag317 : Boolean; - end record; - - pragma Pack (Flag_Byte4); - for Flag_Byte4'Size use 8; - - type Flag_Byte4_Ptr is access all Flag_Byte4; - - function To_Flag_Byte4 is new - Unchecked_Conversion (Node_Kind, Flag_Byte4); - - function To_Flag_Byte4_Ptr is new - Unchecked_Conversion (Node_Kind_Ptr, Flag_Byte4_Ptr); - - -- The following declarations are used to store flags 73-96 and the - -- Convention field in the Field12 field of the third component of an - -- extended (Entity) node. - - type Flag_Word is record - Flag73 : Boolean; - Flag74 : Boolean; - Flag75 : Boolean; - Flag76 : Boolean; - Flag77 : Boolean; - Flag78 : Boolean; - Flag79 : Boolean; - Flag80 : Boolean; - - Flag81 : Boolean; - Flag82 : Boolean; - Flag83 : Boolean; - Flag84 : Boolean; - Flag85 : Boolean; - Flag86 : Boolean; - Flag87 : Boolean; - Flag88 : Boolean; - - Flag89 : Boolean; - Flag90 : Boolean; - Flag91 : Boolean; - Flag92 : Boolean; - Flag93 : Boolean; - Flag94 : Boolean; - Flag95 : Boolean; - Flag96 : Boolean; - - Convention : Convention_Id; - end record; - - pragma Pack (Flag_Word); - for Flag_Word'Size use 32; - for Flag_Word'Alignment use 4; - - type Flag_Word_Ptr is access all Flag_Word; - type Union_Id_Ptr is access all Union_Id; - - function To_Flag_Word is new - Unchecked_Conversion (Union_Id, Flag_Word); - - function To_Flag_Word_Ptr is new - Unchecked_Conversion (Union_Id_Ptr, Flag_Word_Ptr); - - -- The following declarations are used to store flags 97-128 in the - -- Field12 field of the fourth component of an extended (entity) node. - - type Flag_Word2 is record - Flag97 : Boolean; - Flag98 : Boolean; - Flag99 : Boolean; - Flag100 : Boolean; - Flag101 : Boolean; - Flag102 : Boolean; - Flag103 : Boolean; - Flag104 : Boolean; - - Flag105 : Boolean; - Flag106 : Boolean; - Flag107 : Boolean; - Flag108 : Boolean; - Flag109 : Boolean; - Flag110 : Boolean; - Flag111 : Boolean; - Flag112 : Boolean; - - Flag113 : Boolean; - Flag114 : Boolean; - Flag115 : Boolean; - Flag116 : Boolean; - Flag117 : Boolean; - Flag118 : Boolean; - Flag119 : Boolean; - Flag120 : Boolean; - - Flag121 : Boolean; - Flag122 : Boolean; - Flag123 : Boolean; - Flag124 : Boolean; - Flag125 : Boolean; - Flag126 : Boolean; - Flag127 : Boolean; - Flag128 : Boolean; - end record; - - pragma Pack (Flag_Word2); - for Flag_Word2'Size use 32; - for Flag_Word2'Alignment use 4; - - type Flag_Word2_Ptr is access all Flag_Word2; - - function To_Flag_Word2 is new - Unchecked_Conversion (Union_Id, Flag_Word2); - - function To_Flag_Word2_Ptr is new - Unchecked_Conversion (Union_Id_Ptr, Flag_Word2_Ptr); - - -- The following declarations are used to store flags 152-183 in the - -- Field11 field of the fourth component of an extended (entity) node. - - type Flag_Word3 is record - Flag152 : Boolean; - Flag153 : Boolean; - Flag154 : Boolean; - Flag155 : Boolean; - Flag156 : Boolean; - Flag157 : Boolean; - Flag158 : Boolean; - Flag159 : Boolean; - - Flag160 : Boolean; - Flag161 : Boolean; - Flag162 : Boolean; - Flag163 : Boolean; - Flag164 : Boolean; - Flag165 : Boolean; - Flag166 : Boolean; - Flag167 : Boolean; - - Flag168 : Boolean; - Flag169 : Boolean; - Flag170 : Boolean; - Flag171 : Boolean; - Flag172 : Boolean; - Flag173 : Boolean; - Flag174 : Boolean; - Flag175 : Boolean; - - Flag176 : Boolean; - Flag177 : Boolean; - Flag178 : Boolean; - Flag179 : Boolean; - Flag180 : Boolean; - Flag181 : Boolean; - Flag182 : Boolean; - Flag183 : Boolean; - end record; - - pragma Pack (Flag_Word3); - for Flag_Word3'Size use 32; - for Flag_Word3'Alignment use 4; - - type Flag_Word3_Ptr is access all Flag_Word3; - - function To_Flag_Word3 is new - Unchecked_Conversion (Union_Id, Flag_Word3); - - function To_Flag_Word3_Ptr is new - Unchecked_Conversion (Union_Id_Ptr, Flag_Word3_Ptr); - - -- The following declarations are used to store flags 184-215 in the - -- Field12 field of the fifth component of an extended (entity) node. - - type Flag_Word4 is record - Flag184 : Boolean; - Flag185 : Boolean; - Flag186 : Boolean; - Flag187 : Boolean; - Flag188 : Boolean; - Flag189 : Boolean; - Flag190 : Boolean; - Flag191 : Boolean; - - Flag192 : Boolean; - Flag193 : Boolean; - Flag194 : Boolean; - Flag195 : Boolean; - Flag196 : Boolean; - Flag197 : Boolean; - Flag198 : Boolean; - Flag199 : Boolean; - - Flag200 : Boolean; - Flag201 : Boolean; - Flag202 : Boolean; - Flag203 : Boolean; - Flag204 : Boolean; - Flag205 : Boolean; - Flag206 : Boolean; - Flag207 : Boolean; - - Flag208 : Boolean; - Flag209 : Boolean; - Flag210 : Boolean; - Flag211 : Boolean; - Flag212 : Boolean; - Flag213 : Boolean; - Flag214 : Boolean; - Flag215 : Boolean; - end record; - - pragma Pack (Flag_Word4); - for Flag_Word4'Size use 32; - for Flag_Word4'Alignment use 4; - - type Flag_Word4_Ptr is access all Flag_Word4; - - function To_Flag_Word4 is new - Unchecked_Conversion (Union_Id, Flag_Word4); - - function To_Flag_Word4_Ptr is new - Unchecked_Conversion (Union_Id_Ptr, Flag_Word4_Ptr); - - -- The following declarations are used to store flags 255-286 in the - -- Field12 field of the sixth component of an extended (entity) node. - - type Flag_Word5 is record - Flag255 : Boolean; - Flag256 : Boolean; - Flag257 : Boolean; - Flag258 : Boolean; - Flag259 : Boolean; - Flag260 : Boolean; - Flag261 : Boolean; - Flag262 : Boolean; - - Flag263 : Boolean; - Flag264 : Boolean; - Flag265 : Boolean; - Flag266 : Boolean; - Flag267 : Boolean; - Flag268 : Boolean; - Flag269 : Boolean; - Flag270 : Boolean; - - Flag271 : Boolean; - Flag272 : Boolean; - Flag273 : Boolean; - Flag274 : Boolean; - Flag275 : Boolean; - Flag276 : Boolean; - Flag277 : Boolean; - Flag278 : Boolean; - - Flag279 : Boolean; - Flag280 : Boolean; - Flag281 : Boolean; - Flag282 : Boolean; - Flag283 : Boolean; - Flag284 : Boolean; - Flag285 : Boolean; - Flag286 : Boolean; - end record; - - pragma Pack (Flag_Word5); - for Flag_Word5'Size use 32; - for Flag_Word5'Alignment use 4; - - type Flag_Word5_Ptr is access all Flag_Word5; - - function To_Flag_Word5 is new - Unchecked_Conversion (Union_Id, Flag_Word5); - - function To_Flag_Word5_Ptr is new - Unchecked_Conversion (Union_Id_Ptr, Flag_Word5_Ptr); - -------------------------------------------------- -- Implementation of Tree Substitution Routines -- -------------------------------------------------- @@ -494,26 +133,28 @@ package body Atree is -- Note: eventually, this should be a field in the Node directly, but -- for now we do not want to disturb the efficiency of a power of 2 - -- for the node size. ????We are planning to get rid of power-of-2. + -- for the node size. ????We are getting rid of power-of-2. package Orig_Nodes is new Table.Table ( Table_Component_Type => Node_Id, Table_Index_Type => Node_Id'Base, Table_Low_Bound => First_Node_Id, - Table_Initial => Alloc.Nodes_Initial, - Table_Increment => Alloc.Nodes_Increment, - Release_Threshold => Alloc.Nodes_Release_Threshold, + Table_Initial => Alloc.Node_Offsets_Initial, + Table_Increment => Alloc.Node_Offsets_Increment, Table_Name => "Orig_Nodes"); -------------------------- -- Paren_Count Handling -- -------------------------- - -- As noted in the spec, the paren count in a sub-expression node has - -- four possible values 0,1,2, and 3. The value 3 really means 3 or more, - -- and we use an auxiliary serially scanned table to record the actual - -- count. A serial search is fine, only pathological programs will use - -- entries in this table. Normal programs won't use it at all. + -- The Small_Paren_Count field has range 0 .. 3. If the Paren_Count is + -- in the range 0 .. 2, then it is stoed as Small_Paren_Count. Otherwise, + -- Small_Paren_Count = 3, and the actual Paren_Count is stored in the + -- Paren_Counts table. + -- + -- We use linear search on the Paren_Counts table, which is plenty + -- efficient because only pathological programs will use it. Nobody + -- writes (((X + Y))). type Paren_Count_Entry is record Nod : Node_Id; @@ -540,14 +181,18 @@ package body Atree is -- Local Subprograms -- ----------------------- - function Allocate_New_Node return Node_Id; + function Is_Entity (N : Node_Or_Entity_Id) return Boolean; + pragma Inline (Is_Entity); + -- Returns True if N is an entity + + function Allocate_New_Node (Kind : Node_Kind) return Node_Id; pragma Inline (Allocate_New_Node); -- Allocate a new node or first part of a node extension. Initialize the -- Nodes.Table entry, Flags, Orig_Nodes, and List tables. procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id); - -- Fix up parent pointers for the syntactic children of Fix_Node after a - -- copy, setting them to Fix_Node when they pointed to Ref_Node. + -- Fix up parent pointers for the children of Fix_Node after a copy, + -- setting them to Fix_Node when they pointed to Ref_Node. procedure Mark_New_Ghost_Node (N : Node_Or_Entity_Id); -- Mark arbitrary node or entity N as Ghost when it is created within a @@ -557,55 +202,922 @@ package body Atree is pragma Inline (Report); -- Invoke the reporting procedure if available - ----------------------- - -- Allocate_New_Node -- - ----------------------- + function Size_In_Slots (N : Node_Or_Entity_Id) return Field_Offset; + -- Number of slots belonging to N. This can be less than + -- Size_In_Slots_To_Alloc for entities. + + function Size_In_Slots_To_Alloc (N : Node_Or_Entity_Id) return Field_Offset; + function Size_In_Slots_To_Alloc (Kind : Node_Kind) return Field_Offset; + -- Number of slots to allocate for a node or entity. For entities, we have + -- to allocate the max, because we don't know the Ekind when this is + -- called. + + function Off_0 (N : Node_Id) return Node_Offset; + -- Offset of the first slot of N (offset 0) in Slots.Table + + function Off_L (N : Node_Id) return Node_Offset; + -- Offset of the last slot of N in Slots.Table + + procedure Zero_Slots (F, L : Node_Offset) with Inline; + -- Set slots in the range F..L to zero + + procedure Zero_Slots (N : Node_Or_Entity_Id) with Inline; + -- Zero the slots belonging to N + + procedure Copy_Slots (From, To, Num_Slots : Node_Offset) with Inline; + -- Copy Num_Slots slots from From to To + + procedure Copy_Slots (Source, Destination : Node_Id) with Inline; + -- Copies the slots of Source to Destination + + function Get_Field_Value + (N : Node_Id; Field : Node_Field) return Field_32_Bit; + -- Get any field value as a Field_32_Bit. If the field is smaller than 32 + -- bits, convert it to Field_32_Bit. + + procedure Set_Field_Value + (N : Node_Id; Field : Node_Field; Val : Field_32_Bit); + -- Set any field value as a Field_32_Bit. If the field is smaller than 32 + -- bits, convert it from Field_32_Bit, and Val had better be small enough. + + procedure Check_Vanishing_Fields + (Old_N : Node_Id; New_Kind : Node_Kind); + -- Called whenever Nkind is modified. Raises an exception if not all + -- vanishing fields are in their initial zero state. + + function Get_Field_Value + (N : Entity_Id; Field : Entity_Field) return Field_32_Bit; + procedure Set_Field_Value + (N : Entity_Id; Field : Entity_Field; Val : Field_32_Bit); + procedure Check_Vanishing_Fields + (Old_N : Entity_Id; New_Kind : Entity_Kind); + -- Above are the same as the ones for nodes, but for entities + + procedure Init_Nkind (N : Node_Id; Val : Node_Kind); + -- Initialize the Nkind field, which must not have been set already. This + -- cannot be used to modify an already-initialized Nkind field. See also + -- Mutate_Nkind. + + package Field_Checking is + function Field_Present + (Kind : Node_Kind; Field : Node_Field) return Boolean; + function Field_Present + (Kind : Entity_Kind; Field : Entity_Field) return Boolean; + end Field_Checking; + + package body Field_Checking is + + -- Tables used by Field_Present + + type Node_Field_Sets is array (Node_Kind) of Node_Field_Set; + type Node_Field_Sets_Ptr is access all Node_Field_Sets; + Node_Fields_Present : Node_Field_Sets_Ptr; + + type Entity_Field_Sets is array (Entity_Kind) of Entity_Field_Set; + type Entity_Field_Sets_Ptr is access all Entity_Field_Sets; + Entity_Fields_Present : Entity_Field_Sets_Ptr; + + procedure Init_Tables; + + function Fields_Present (Kind : Node_Kind) return Node_Field_Set; + function Fields_Present (Kind : Entity_Kind) return Entity_Field_Set; + -- Computes the set of fields present in each Node/Entity Kind. Used to + -- initialize the above tables. + + -------------------- + -- Fields_Present -- + -------------------- + + function Fields_Present (Kind : Node_Kind) return Node_Field_Set is + Result : Node_Field_Set := (others => False); + begin + for J in Node_Field_Table (Kind)'Range loop + Result (Node_Field_Table (Kind) (J)) := True; + end loop; + + return Result; + end Fields_Present; + + function Fields_Present (Kind : Entity_Kind) return Entity_Field_Set is + Result : Entity_Field_Set := (others => False); + begin + for J in Entity_Field_Table (Kind)'Range loop + Result (Entity_Field_Table (Kind) (J)) := True; + end loop; + + return Result; + end Fields_Present; + + procedure Init_Tables is + begin + Node_Fields_Present := new Node_Field_Sets; + + for Kind in Node_Kind loop + Node_Fields_Present (Kind) := Fields_Present (Kind); + end loop; + + Entity_Fields_Present := new Entity_Field_Sets; + + for Kind in Entity_Kind loop + Entity_Fields_Present (Kind) := Fields_Present (Kind); + end loop; + end Init_Tables; + + -- In production mode, we leave Node_Fields_Present and + -- Entity_Fields_Present null. Field_Present is only for + -- use in assertions. + + pragma Debug (Init_Tables); + + function Field_Present + (Kind : Node_Kind; Field : Node_Field) return Boolean is + begin + if Node_Fields_Present = null then + return True; + end if; + + return Node_Fields_Present (Kind) (Field); + end Field_Present; + + function Field_Present + (Kind : Entity_Kind; Field : Entity_Field) return Boolean is + begin + if Entity_Fields_Present = null then + return True; + end if; + + return Entity_Fields_Present (Kind) (Field); + end Field_Present; + + end Field_Checking; + + ------------------------ + -- Atree_Private_Part -- + ------------------------ + + package body Atree_Private_Part is + + -- The following validators are disabled in production builds, by being + -- called in pragma Debug. They are also disabled by default in debug + -- builds, by setting the flags below, because they make the compiler + -- very slow (10 to 20 times slower). Validate can be set True to debug + -- the low-level accessors. + -- + -- Even if Validate is True, validation is disabled during + -- Validate_... calls to prevent infinite recursion + -- (Validate_... procedures call field getters, which call + -- Validate_... procedures). That's what the Enable_Validate_... + -- flags are for; they are toggled so that when we're inside one + -- of them, and enter it again, the inner call doesn't do anything. + -- These flags are irrelevant when Validate is False. + + Validate : constant Boolean := False; + + Enable_Validate_Node, + Enable_Validate_Node_Write, + Enable_Validate_Node_And_Offset, + Enable_Validate_Node_And_Offset_Write : + Boolean := Validate; + + procedure Validate_Node_And_Offset + (N : Node_Or_Entity_Id; Offset : Field_Offset); + procedure Validate_Node_And_Offset_Write + (N : Node_Or_Entity_Id; Offset : Field_Offset); + -- Asserts N is OK, and the Offset in slots is within N. Note that this + -- does not guarantee that the offset is valid, just that it's not past + -- the last slot. It could be pointing at unused bits within the node, + -- or unused padding at the end. + + procedure Validate_Node_And_Offset + (N : Node_Or_Entity_Id; Offset : Field_Offset) is + begin + if Enable_Validate_Node_And_Offset then + Enable_Validate_Node_And_Offset := False; + + pragma Debug (Validate_Node (N)); + pragma Assert (Offset'Valid); + pragma Assert (Offset < Size_In_Slots (N)); + + Enable_Validate_Node_And_Offset := True; + end if; + end Validate_Node_And_Offset; + + procedure Validate_Node_And_Offset_Write + (N : Node_Or_Entity_Id; Offset : Field_Offset) is + begin + if Enable_Validate_Node_And_Offset_Write then + Enable_Validate_Node_And_Offset_Write := False; + + pragma Debug (Validate_Node_Write (N)); + pragma Assert (Offset'Valid); + pragma Assert (Offset < Size_In_Slots (N)); + + Enable_Validate_Node_And_Offset_Write := True; + end if; + end Validate_Node_And_Offset_Write; + + procedure Validate_Node (N : Node_Or_Entity_Id) is + begin + if Enable_Validate_Node then + Enable_Validate_Node := False; + + pragma Assert (N'Valid); + pragma Assert (N <= Node_Offsets.Last); + pragma Assert (Off_0 (N) < Off_L (N)); + pragma Assert (Off_L (N) <= Slots.Last); + pragma Assert (Nkind (N)'Valid); + pragma Assert (Nkind (N) /= N_Unused_At_End); + + if Nkind (N) in N_Entity then + pragma Assert (Ekind (N)'Valid); + end if; + + if Nkind (N) in N_Attribute_Definition_Clause + | N_Has_Entity + | N_Aggregate + | N_Extension_Aggregate + | N_Selected_Component + | N_Use_Package_Clause + | N_Aspect_Specification + | N_Freeze_Entity + | N_Freeze_Generic_Entity + then + pragma Assert (Entity_Or_Associated_Node (N)'Valid); + end if; + + Enable_Validate_Node := True; + end if; + end Validate_Node; + + procedure Validate_Node_Write (N : Node_Or_Entity_Id) is + begin + if Enable_Validate_Node_Write then + Enable_Validate_Node_Write := False; + + pragma Debug (Validate_Node (N)); + pragma Assert (not Locked); + + Enable_Validate_Node_Write := True; + end if; + end Validate_Node_Write; + + function Is_Valid_Node (U : Union_Id) return Boolean is + begin + return Node_Id'Base (U) <= Node_Offsets.Last; + end Is_Valid_Node; + + function Alloc_Node_Id return Node_Id is + begin + Node_Offsets.Increment_Last; + return Node_Offsets.Last; + end Alloc_Node_Id; + + function Alloc_Slots (Num_Slots : Field_Offset) return Node_Offset is + begin + return Result : constant Node_Offset := Slots.Last + 1 do + Slots.Set_Last (Slots.Last + Num_Slots); + end return; + end Alloc_Slots; + + function Get_1_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + is + pragma Assert (Field_Type'Size = 1); + + function Cast is new Unchecked_Conversion (Field_1_Bit, Field_Type); + begin + return Cast (Get_1_Bit_Val (N, Offset)); + end Get_1_Bit_Field; + + function Get_2_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + is + pragma Assert (Field_Type'Size = 2); + + function Cast is new Unchecked_Conversion (Field_2_Bit, Field_Type); + begin + return Cast (Get_2_Bit_Val (N, Offset)); + end Get_2_Bit_Field; + + function Get_4_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + is + pragma Assert (Field_Type'Size = 4); + + function Cast is new Unchecked_Conversion (Field_4_Bit, Field_Type); + begin + return Cast (Get_4_Bit_Val (N, Offset)); + end Get_4_Bit_Field; + + function Get_8_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + is + pragma Assert (Field_Type'Size = 8); + + function Cast is new Unchecked_Conversion (Field_8_Bit, Field_Type); + begin + return Cast (Get_8_Bit_Val (N, Offset)); + end Get_8_Bit_Field; + + function Get_32_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + is + pragma Assert (Field_Type'Size = 32); + + function Cast is new Unchecked_Conversion (Field_32_Bit, Field_Type); + begin + return Cast (Get_32_Bit_Val (N, Offset)); + end Get_32_Bit_Field; + + function Get_32_Bit_Field_With_Default + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + is + function Get_Field is new Get_32_Bit_Field (Field_Type) with Inline; + begin + -- If the field has not yet been set, it will be equal to zero. + -- That is of the "wrong" type, so we fetch it as a Field_32_Bit. + + if Get_32_Bit_Val (N, Offset) = 0 then + return Default_Val; + + else + return Get_Field (N, Offset); + end if; + end Get_32_Bit_Field_With_Default; + + procedure Set_1_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + is + pragma Assert (Field_Type'Size = 1); + + function Cast is new Unchecked_Conversion (Field_Type, Field_1_Bit); + begin + Set_1_Bit_Val (N, Offset, Cast (Val)); + end Set_1_Bit_Field; + + procedure Set_2_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + is + pragma Assert (Field_Type'Size = 2); + + function Cast is new Unchecked_Conversion (Field_Type, Field_2_Bit); + begin + Set_2_Bit_Val (N, Offset, Cast (Val)); + end Set_2_Bit_Field; + + procedure Set_4_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + is + pragma Assert (Field_Type'Size = 4); + + function Cast is new Unchecked_Conversion (Field_Type, Field_4_Bit); + begin + Set_4_Bit_Val (N, Offset, Cast (Val)); + end Set_4_Bit_Field; + + procedure Set_8_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + is + pragma Assert (Field_Type'Size = 8); + + function Cast is new Unchecked_Conversion (Field_Type, Field_8_Bit); + begin + Set_8_Bit_Val (N, Offset, Cast (Val)); + end Set_8_Bit_Field; + + procedure Set_32_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + is + pragma Assert (Field_Type'Size = 32); + + function Cast is new Unchecked_Conversion (Field_Type, Field_32_Bit); + begin + Set_32_Bit_Val (N, Offset, Cast (Val)); + end Set_32_Bit_Field; + + function Get_1_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_1_Bit + is + -- We wish we were using packed arrays, but instead we're simulating + -- packed arrays using packed records. L here (and elsewhere) is the + -- 'Length of that array. + L : constant Field_Offset := 32; + + pragma Debug (Validate_Node_And_Offset (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => return S.Slot_1.F0; + when 1 => return S.Slot_1.F1; + when 2 => return S.Slot_1.F2; + when 3 => return S.Slot_1.F3; + when 4 => return S.Slot_1.F4; + when 5 => return S.Slot_1.F5; + when 6 => return S.Slot_1.F6; + when 7 => return S.Slot_1.F7; + when 8 => return S.Slot_1.F8; + when 9 => return S.Slot_1.F9; + when 10 => return S.Slot_1.F10; + when 11 => return S.Slot_1.F11; + when 12 => return S.Slot_1.F12; + when 13 => return S.Slot_1.F13; + when 14 => return S.Slot_1.F14; + when 15 => return S.Slot_1.F15; + when 16 => return S.Slot_1.F16; + when 17 => return S.Slot_1.F17; + when 18 => return S.Slot_1.F18; + when 19 => return S.Slot_1.F19; + when 20 => return S.Slot_1.F20; + when 21 => return S.Slot_1.F21; + when 22 => return S.Slot_1.F22; + when 23 => return S.Slot_1.F23; + when 24 => return S.Slot_1.F24; + when 25 => return S.Slot_1.F25; + when 26 => return S.Slot_1.F26; + when 27 => return S.Slot_1.F27; + when 28 => return S.Slot_1.F28; + when 29 => return S.Slot_1.F29; + when 30 => return S.Slot_1.F30; + when 31 => return S.Slot_1.F31; + end case; + end Get_1_Bit_Val; + + function Get_2_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_2_Bit + is + L : constant Field_Offset := 16; + + pragma Debug (Validate_Node_And_Offset (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => return S.Slot_2.F0; + when 1 => return S.Slot_2.F1; + when 2 => return S.Slot_2.F2; + when 3 => return S.Slot_2.F3; + when 4 => return S.Slot_2.F4; + when 5 => return S.Slot_2.F5; + when 6 => return S.Slot_2.F6; + when 7 => return S.Slot_2.F7; + when 8 => return S.Slot_2.F8; + when 9 => return S.Slot_2.F9; + when 10 => return S.Slot_2.F10; + when 11 => return S.Slot_2.F11; + when 12 => return S.Slot_2.F12; + when 13 => return S.Slot_2.F13; + when 14 => return S.Slot_2.F14; + when 15 => return S.Slot_2.F15; + end case; + end Get_2_Bit_Val; + + function Get_4_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_4_Bit + is + L : constant Field_Offset := 8; + + pragma Debug (Validate_Node_And_Offset (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => return S.Slot_4.F0; + when 1 => return S.Slot_4.F1; + when 2 => return S.Slot_4.F2; + when 3 => return S.Slot_4.F3; + when 4 => return S.Slot_4.F4; + when 5 => return S.Slot_4.F5; + when 6 => return S.Slot_4.F6; + when 7 => return S.Slot_4.F7; + end case; + end Get_4_Bit_Val; + + function Get_8_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_8_Bit + is + L : constant Field_Offset := 4; + + pragma Debug (Validate_Node_And_Offset (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => return S.Slot_8.F0; + when 1 => return S.Slot_8.F1; + when 2 => return S.Slot_8.F2; + when 3 => return S.Slot_8.F3; + end case; + end Get_8_Bit_Val; + + function Get_32_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_32_Bit + is + pragma Debug (Validate_Node_And_Offset (N, Offset)); + + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset); + begin + return S.Slot_32; + end Get_32_Bit_Val; + + procedure Set_1_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_1_Bit) + is + L : constant Field_Offset := 32; + + pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => S.Slot_1.F0 := Val; + when 1 => S.Slot_1.F1 := Val; + when 2 => S.Slot_1.F2 := Val; + when 3 => S.Slot_1.F3 := Val; + when 4 => S.Slot_1.F4 := Val; + when 5 => S.Slot_1.F5 := Val; + when 6 => S.Slot_1.F6 := Val; + when 7 => S.Slot_1.F7 := Val; + when 8 => S.Slot_1.F8 := Val; + when 9 => S.Slot_1.F9 := Val; + when 10 => S.Slot_1.F10 := Val; + when 11 => S.Slot_1.F11 := Val; + when 12 => S.Slot_1.F12 := Val; + when 13 => S.Slot_1.F13 := Val; + when 14 => S.Slot_1.F14 := Val; + when 15 => S.Slot_1.F15 := Val; + when 16 => S.Slot_1.F16 := Val; + when 17 => S.Slot_1.F17 := Val; + when 18 => S.Slot_1.F18 := Val; + when 19 => S.Slot_1.F19 := Val; + when 20 => S.Slot_1.F20 := Val; + when 21 => S.Slot_1.F21 := Val; + when 22 => S.Slot_1.F22 := Val; + when 23 => S.Slot_1.F23 := Val; + when 24 => S.Slot_1.F24 := Val; + when 25 => S.Slot_1.F25 := Val; + when 26 => S.Slot_1.F26 := Val; + when 27 => S.Slot_1.F27 := Val; + when 28 => S.Slot_1.F28 := Val; + when 29 => S.Slot_1.F29 := Val; + when 30 => S.Slot_1.F30 := Val; + when 31 => S.Slot_1.F31 := Val; + end case; + end Set_1_Bit_Val; + + procedure Set_2_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_2_Bit) + is + L : constant Field_Offset := 16; + + pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => S.Slot_2.F0 := Val; + when 1 => S.Slot_2.F1 := Val; + when 2 => S.Slot_2.F2 := Val; + when 3 => S.Slot_2.F3 := Val; + when 4 => S.Slot_2.F4 := Val; + when 5 => S.Slot_2.F5 := Val; + when 6 => S.Slot_2.F6 := Val; + when 7 => S.Slot_2.F7 := Val; + when 8 => S.Slot_2.F8 := Val; + when 9 => S.Slot_2.F9 := Val; + when 10 => S.Slot_2.F10 := Val; + when 11 => S.Slot_2.F11 := Val; + when 12 => S.Slot_2.F12 := Val; + when 13 => S.Slot_2.F13 := Val; + when 14 => S.Slot_2.F14 := Val; + when 15 => S.Slot_2.F15 := Val; + end case; + end Set_2_Bit_Val; + + procedure Set_4_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_4_Bit) + is + L : constant Field_Offset := 8; + + pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => S.Slot_4.F0 := Val; + when 1 => S.Slot_4.F1 := Val; + when 2 => S.Slot_4.F2 := Val; + when 3 => S.Slot_4.F3 := Val; + when 4 => S.Slot_4.F4 := Val; + when 5 => S.Slot_4.F5 := Val; + when 6 => S.Slot_4.F6 := Val; + when 7 => S.Slot_4.F7 := Val; + end case; + end Set_4_Bit_Val; + + procedure Set_8_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_8_Bit) + is + L : constant Field_Offset := 4; + + pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L)); + + subtype Offset_In_Slot is Field_Offset range 0 .. L - 1; + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); + begin + case Offset_In_Slot'(Offset mod L) is + when 0 => S.Slot_8.F0 := Val; + when 1 => S.Slot_8.F1 := Val; + when 2 => S.Slot_8.F2 := Val; + when 3 => S.Slot_8.F3 := Val; + end case; + end Set_8_Bit_Val; + + procedure Set_32_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_32_Bit) + is + pragma Debug (Validate_Node_And_Offset_Write (N, Offset)); + + S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset); + begin + S.Slot_32 := Val; + end Set_32_Bit_Val; + + end Atree_Private_Part; + + --------------- + -- Set_Field -- + --------------- + + function Get_Node_Field_Union is new Get_32_Bit_Field (Union_Id) + with Inline; + -- Called when we don't know whether a field is a Node_Id or a List_Id, + -- etc. + + function Get_Field_Value + (N : Node_Id; Field : Node_Field) return Field_32_Bit + is + pragma Assert (Field_Checking.Field_Present (Nkind (N), Field)); + Desc : Field_Descriptor renames Node_Field_Descriptors (Field); - function Allocate_New_Node return Node_Id is - New_Id : Node_Id; begin - Nodes.Append (Default_Node); - New_Id := Nodes.Last; - Flags.Append (Default_Flags); - Orig_Nodes.Append (New_Id); - Nodes.Table (Nodes.Last).Comes_From_Source := - Comes_From_Source_Default; - Allocate_List_Tables (Nodes.Last); - Report (Target => New_Id, Source => Empty); + case Field_Size (Desc.Kind) is + when 1 => return Field_32_Bit (Get_1_Bit_Val (N, Desc.Offset)); + when 2 => return Field_32_Bit (Get_2_Bit_Val (N, Desc.Offset)); + when 4 => return Field_32_Bit (Get_4_Bit_Val (N, Desc.Offset)); + when 8 => return Field_32_Bit (Get_8_Bit_Val (N, Desc.Offset)); + when others => return Get_32_Bit_Val (N, Desc.Offset); -- 32 + end case; + end Get_Field_Value; - return New_Id; - end Allocate_New_Node; + procedure Set_Field_Value + (N : Node_Id; Field : Node_Field; Val : Field_32_Bit) + is + pragma Assert (Field_Checking.Field_Present (Nkind (N), Field)); + Desc : Field_Descriptor renames Node_Field_Descriptors (Field); - -------------- - -- Analyzed -- - -------------- + begin + case Field_Size (Desc.Kind) is + when 1 => Set_1_Bit_Val (N, Desc.Offset, Field_1_Bit (Val)); + when 2 => Set_2_Bit_Val (N, Desc.Offset, Field_2_Bit (Val)); + when 4 => Set_4_Bit_Val (N, Desc.Offset, Field_4_Bit (Val)); + when 8 => Set_8_Bit_Val (N, Desc.Offset, Field_8_Bit (Val)); + when others => Set_32_Bit_Val (N, Desc.Offset, Val); -- 32 + end case; + end Set_Field_Value; - function Analyzed (N : Node_Id) return Boolean is + procedure Reinit_Field_To_Zero (N : Node_Id; Field : Node_Field) is begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Analyzed; - end Analyzed; + Set_Field_Value (N, Field, 0); + end Reinit_Field_To_Zero; - -------------------------- - -- Basic_Set_Convention -- - -------------------------- + function Field_Is_Initial_Zero + (N : Node_Id; Field : Node_Field) return Boolean is + begin + return Get_Field_Value (N, Field) = 0; + end Field_Is_Initial_Zero; - procedure Basic_Set_Convention (E : Entity_Id; Val : Convention_Id) is + procedure Reinit_Field_To_Zero + (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind_Set) is begin - pragma Assert (Nkind (E) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention := Val; - end Basic_Set_Convention; + pragma Assert (Old_Ekind (Ekind (N)), "Reinit: " & Ekind (N)'Img); + Reinit_Field_To_Zero (N, Field); + end Reinit_Field_To_Zero; - ------------------- - -- Check_Actuals -- - ------------------- + procedure Reinit_Field_To_Zero + (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind) is + Old_Ekind_Set : Entity_Kind_Set := (others => False); + begin + Old_Ekind_Set (Old_Ekind) := True; + Reinit_Field_To_Zero (N, Field, Old_Ekind => Old_Ekind_Set); + end Reinit_Field_To_Zero; + + procedure Check_Vanishing_Fields + (Old_N : Node_Id; New_Kind : Node_Kind) + is + Old_Kind : constant Node_Kind := Nkind (Old_N); + + -- If this fails, it means you need to call Reinit_Field_To_Zero before + -- calling Set_Nkind. - function Check_Actuals (N : Node_Id) return Boolean is begin - return Flags.Table (N).Check_Actuals; - end Check_Actuals; + for J in Node_Field_Table (Old_Kind)'Range loop + declare + F : constant Node_Field := Node_Field_Table (Old_Kind) (J); + begin + if not Field_Checking.Field_Present (New_Kind, F) then + if not Field_Is_Initial_Zero (Old_N, F) then + Write_Str (Old_Kind'Img); + Write_Str (" --> "); + Write_Str (New_Kind'Img); + Write_Str (" Nonzero field "); + Write_Str (F'Img); + Write_Str (" is vanishing"); + Write_Eol; + + raise Program_Error; + end if; + end if; + end; + end loop; + end Check_Vanishing_Fields; + + function Get_Field_Value + (N : Entity_Id; Field : Entity_Field) return Field_32_Bit + is + pragma Assert (Field_Checking.Field_Present (Ekind (N), Field)); + Desc : Field_Descriptor renames Entity_Field_Descriptors (Field); + begin + case Field_Size (Desc.Kind) is + when 1 => return Field_32_Bit (Get_1_Bit_Val (N, Desc.Offset)); + when 2 => return Field_32_Bit (Get_2_Bit_Val (N, Desc.Offset)); + when 4 => return Field_32_Bit (Get_4_Bit_Val (N, Desc.Offset)); + when 8 => return Field_32_Bit (Get_8_Bit_Val (N, Desc.Offset)); + when others => return Get_32_Bit_Val (N, Desc.Offset); -- 32 + end case; + end Get_Field_Value; + + procedure Set_Field_Value + (N : Entity_Id; Field : Entity_Field; Val : Field_32_Bit) + is + pragma Assert (Field_Checking.Field_Present (Ekind (N), Field)); + Desc : Field_Descriptor renames Entity_Field_Descriptors (Field); + begin + case Field_Size (Desc.Kind) is + when 1 => Set_1_Bit_Val (N, Desc.Offset, Field_1_Bit (Val)); + when 2 => Set_2_Bit_Val (N, Desc.Offset, Field_2_Bit (Val)); + when 4 => Set_4_Bit_Val (N, Desc.Offset, Field_4_Bit (Val)); + when 8 => Set_8_Bit_Val (N, Desc.Offset, Field_8_Bit (Val)); + when others => Set_32_Bit_Val (N, Desc.Offset, Val); -- 32 + end case; + end Set_Field_Value; + + procedure Reinit_Field_To_Zero (N : Node_Id; Field : Entity_Field) is + begin + Set_Field_Value (N, Field, 0); + end Reinit_Field_To_Zero; + + function Field_Is_Initial_Zero + (N : Entity_Id; Field : Entity_Field) return Boolean is + begin + return Get_Field_Value (N, Field) = 0; + end Field_Is_Initial_Zero; + + procedure Check_Vanishing_Fields + (Old_N : Entity_Id; New_Kind : Entity_Kind) + is + Old_Kind : constant Entity_Kind := Ekind (Old_N); + + -- If this fails, it means you need to call Reinit_Field_To_Zero before + -- calling Set_Ekind. + + begin + for J in Entity_Field_Table (Old_Kind)'Range loop + declare + F : constant Entity_Field := Entity_Field_Table (Old_Kind) (J); + begin + if not Field_Checking.Field_Present (New_Kind, F) then + if not Field_Is_Initial_Zero (Old_N, F) then + Write_Str (Old_Kind'Img); + Write_Str (" --> "); + Write_Str (New_Kind'Img); + Write_Str (" Nonzero field "); + Write_Str (F'Img); + Write_Str (" is vanishing"); + Write_Eol; + + pragma Assert (New_Kind = E_Void or else Old_Kind = E_Void); + + raise Program_Error; + end if; + end if; + end; + end loop; + end Check_Vanishing_Fields; + + Nkind_Offset : constant Field_Offset := + Node_Field_Descriptors (Nkind).Offset; + + procedure Set_Nkind_Type is new Set_8_Bit_Field (Node_Kind) with Inline; + + procedure Init_Nkind (N : Node_Id; Val : Node_Kind) is + pragma Assert (Field_Is_Initial_Zero (N, Nkind)); + begin + Set_Nkind_Type (N, Nkind_Offset, Val); + end Init_Nkind; + + procedure Mutate_Nkind + (N : Node_Id; Val : Node_Kind) + is + Old_Size : constant Field_Offset := Size_In_Slots (N); + New_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Val); + + All_Node_Offsets : Node_Offsets.Table_Type renames + Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); + begin + pragma Debug (Check_Vanishing_Fields (N, Val)); + + -- Grow the slots if necessary + + if Old_Size < New_Size then + declare + Old_Last_Slot : constant Node_Offset := Slots.Last; + Old_Off_0 : constant Node_Offset := Off_0 (N); + begin + if Old_Last_Slot = Old_Off_0 + Old_Size - 1 then + -- In this case, the slots are at the end of Slots.Table, so we + -- don't need to move them. + Slots.Set_Last (Old_Last_Slot + New_Size - Old_Size); + + else + -- Move the slots + All_Node_Offsets (N) := Alloc_Slots (New_Size); + Copy_Slots (Old_Off_0, Off_0 (N), Old_Size); + pragma Debug (Zero_Slots (Old_Off_0, Old_Off_0 + Old_Size - 1)); + end if; + end; + + Zero_Slots (Off_0 (N) + Old_Size, Slots.Last); + end if; + + Set_Nkind_Type (N, Nkind_Offset, Val); + pragma Debug (Validate_Node_Write (N)); + end Mutate_Nkind; + + Ekind_Offset : constant Field_Offset := + Entity_Field_Descriptors (Ekind).Offset; + + procedure Set_Ekind_Type is new Set_8_Bit_Field (Entity_Kind) with Inline; + + procedure Set_Ekind + (N : Entity_Id; Val : Entity_Kind) + is + begin + if Ekind (N) = Val then + return; + end if; + + if Debug_Flag_Underscore_V then + pragma Debug (Check_Vanishing_Fields (N, Val)); + end if; + + -- For now, we are allocating all entities with the same size, so we + -- don't need to reallocate slots here. + + Set_Ekind_Type (N, Ekind_Offset, Val); + pragma Debug (Validate_Node_Write (N)); + end Set_Ekind; + + ----------------------- + -- Allocate_New_Node -- + ----------------------- + + function Allocate_New_Node (Kind : Node_Kind) return Node_Id is + begin + return Result : constant Node_Id := Alloc_Node_Id do + declare + Sz : constant Field_Offset := Size_In_Slots_To_Alloc (Kind); + Sl : constant Node_Offset := Alloc_Slots (Sz); + begin + Node_Offsets.Table (Result) := Sl; + Zero_Slots (Sl, Sl + Sz - 1); + end; + + Init_Nkind (Result, Kind); + + Orig_Nodes.Append (Result); + Set_Comes_From_Source (Result, Comes_From_Source_Default); + Allocate_List_Tables (Result); + Report (Target => Result, Source => Empty); + end return; + end Allocate_New_Node; -------------------------- -- Check_Error_Detected -- @@ -628,20 +1140,21 @@ package body Atree is -- Change_Node -- ----------------- - procedure Change_Node (N : Node_Id; New_Node_Kind : Node_Kind) is - - -- Flags table attributes + procedure Change_Node (N : Node_Id; New_Kind : Node_Kind) is + pragma Debug (Validate_Node_Write (N)); + pragma Assert (Nkind (N) not in N_Entity); + pragma Assert (New_Kind not in N_Entity); - Save_CA : constant Boolean := Flags.Table (N).Check_Actuals; - Save_Is_IGN : constant Boolean := Flags.Table (N).Is_Ignored_Ghost_Node; + Old_Size : constant Field_Offset := Size_In_Slots (N); + New_Size : constant Field_Offset := Size_In_Slots_To_Alloc (New_Kind); - -- Nodes table attributes - - Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source; - Save_In_List : constant Boolean := Nodes.Table (N).In_List; - Save_Link : constant Union_Id := Nodes.Table (N).Link; - Save_Posted : constant Boolean := Nodes.Table (N).Error_Posted; Save_Sloc : constant Source_Ptr := Sloc (N); + Save_In_List : constant Boolean := In_List (N); + Save_CFS : constant Boolean := Comes_From_Source (N); + Save_Posted : constant Boolean := Error_Posted (N); + Save_CA : constant Boolean := Check_Actuals (N); + Save_Is_IGN : constant Boolean := Is_Ignored_Ghost_Node (N); + Save_Link : constant Union_Id := Link (N); Par_Count : Nat := 0; @@ -650,73 +1163,98 @@ package body Atree is Par_Count := Paren_Count (N); end if; - Nodes.Table (N) := Default_Node; - Nodes.Table (N).Sloc := Save_Sloc; - Nodes.Table (N).In_List := Save_In_List; - Nodes.Table (N).Link := Save_Link; - Nodes.Table (N).Comes_From_Source := Save_CFS; - Nodes.Table (N).Nkind := New_Node_Kind; - Nodes.Table (N).Error_Posted := Save_Posted; + if New_Size > Old_Size then + pragma Debug (Zero_Slots (N)); + Node_Offsets.Table (N) := Alloc_Slots (New_Size); + end if; - Flags.Table (N) := Default_Flags; - Flags.Table (N).Check_Actuals := Save_CA; - Flags.Table (N).Is_Ignored_Ghost_Node := Save_Is_IGN; + Zero_Slots (N); - if New_Node_Kind in N_Subexpr then + Mutate_Nkind (N, New_Kind); + + Set_Sloc (N, Save_Sloc); + Set_In_List (N, Save_In_List); + Set_Comes_From_Source (N, Save_CFS); + Set_Error_Posted (N, Save_Posted); + Set_Check_Actuals (N, Save_CA); + Set_Is_Ignored_Ghost_Node (N, Save_Is_IGN); + Set_Link (N, Save_Link); + + if New_Kind in N_Subexpr then Set_Paren_Count (N, Par_Count); end if; end Change_Node; - ----------------------- - -- Comes_From_Source -- - ----------------------- + --------------- + -- Copy_Node -- + --------------- + + procedure Copy_Slots (From, To, Num_Slots : Node_Offset) is + pragma Assert (From /= To); + + All_Slots : Slots.Table_Type renames + Slots.Table (Slots.First .. Slots.Last); + + Source_Slots : Slots.Table_Type renames + All_Slots (From .. From + Num_Slots - 1); + + Destination_Slots : Slots.Table_Type renames + All_Slots (To .. To + Num_Slots - 1); - function Comes_From_Source (N : Node_Id) return Boolean is begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Comes_From_Source; - end Comes_From_Source; + Destination_Slots := Source_Slots; + end Copy_Slots; - ---------------- - -- Convention -- - ---------------- + procedure Copy_Slots (Source, Destination : Node_Id) is + pragma Debug (Validate_Node (Source)); + pragma Debug (Validate_Node_Write (Destination)); + pragma Assert (Source /= Destination); + + S_Size : constant Field_Offset := Size_In_Slots (Source); + + All_Node_Offsets : Node_Offsets.Table_Type renames + Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); - function Convention (E : Entity_Id) return Convention_Id is begin - pragma Assert (Nkind (E) in N_Entity); - return To_Flag_Word (Nodes.Table (E + 2).Field12).Convention; - end Convention; + Copy_Slots + (All_Node_Offsets (Source), All_Node_Offsets (Destination), S_Size); + end Copy_Slots; --------------- -- Copy_Node -- --------------- - procedure Copy_Node (Source : Node_Id; Destination : Node_Id) is - Save_In_List : constant Boolean := Nodes.Table (Destination).In_List; - Save_Link : constant Union_Id := Nodes.Table (Destination).Link; - - begin + procedure Copy_Node (Source, Destination : Node_Or_Entity_Id) is pragma Debug (New_Node_Debugging_Output (Source)); pragma Debug (New_Node_Debugging_Output (Destination)); - Nodes.Table (Destination) := Nodes.Table (Source); - Nodes.Table (Destination).In_List := Save_In_List; - Nodes.Table (Destination).Link := Save_Link; + pragma Assert (Source /= Destination); - Flags.Table (Destination) := Flags.Table (Source); + Save_In_List : constant Boolean := In_List (Destination); + Save_Link : constant Union_Id := Link (Destination); - Set_Paren_Count_Of_Copy (Target => Destination, Source => Source); + S_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Source); + D_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Destination); - -- Deal with copying extension nodes if present. No need to copy flags - -- table entries, since they are always zero for extending components. + begin + -- Currently all entities are allocated the same number of slots. + -- Hopefully that won't always be the case, but if it is, the following + -- is suboptimal if D_Size < S_Size, because in fact the Destination was + -- allocated the max. - pragma Assert (Has_Extension (Source) = Has_Extension (Destination)); + -- If Source doesn't fit in Destination, we need to allocate - if Has_Extension (Source) then - for J in 1 .. Num_Extension_Nodes loop - Nodes.Table (Destination + J) := Nodes.Table (Source + J); - end loop; + if D_Size < S_Size then + pragma Debug (Zero_Slots (Destination)); -- destroy old slots + Node_Offsets.Table (Destination) := Alloc_Slots (S_Size); end if; + + Copy_Slots (Source, Destination); + + Set_In_List (Destination, Save_In_List); + Set_Link (Destination, Save_Link); + + Set_Paren_Count_Of_Copy (Target => Destination, Source => Source); end Copy_Node; ------------------------ @@ -725,10 +1263,9 @@ package body Atree is function Copy_Separate_List (Source : List_Id) return List_Id is Result : constant List_Id := New_List; - Nod : Node_Id; + Nod : Node_Id := First (Source); begin - Nod := First (Source); while Present (Nod) loop Append (Copy_Separate_Tree (Nod), Result); Next (Nod); @@ -742,10 +1279,13 @@ package body Atree is ------------------------ function Copy_Separate_Tree (Source : Node_Id) return Node_Id is + + pragma Debug (Validate_Node (Source)); + New_Id : Node_Id; function Copy_Entity (E : Entity_Id) return Entity_Id; - -- Copy Entity, copying only the Ekind and Chars fields + -- Copy Entity, copying only Chars field function Copy_List (List : List_Id) return List_Id; -- Copy list @@ -759,25 +1299,13 @@ package body Atree is ----------------- function Copy_Entity (E : Entity_Id) return Entity_Id is - New_Ent : Entity_Id; - begin - -- Build appropriate node + pragma Assert (Nkind (E) in N_Entity); - case N_Entity (Nkind (E)) is - when N_Defining_Identifier => - New_Ent := New_Entity (N_Defining_Identifier, Sloc (E)); - - when N_Defining_Character_Literal => - New_Ent := New_Entity (N_Defining_Character_Literal, Sloc (E)); - - when N_Defining_Operator_Symbol => - New_Ent := New_Entity (N_Defining_Operator_Symbol, Sloc (E)); - end case; - - Set_Chars (New_Ent, Chars (E)); - -- Set_Comes_From_Source (New_Ent, Comes_From_Source (E)); - return New_Ent; + return Result : constant Entity_Id := New_Entity (Nkind (E), Sloc (E)) + do + Set_Chars (Result, Chars (E)); + end return; end Copy_Entity; --------------- @@ -797,7 +1325,7 @@ package body Atree is E := First (List); while Present (E) loop - if Has_Extension (E) then + if Is_Entity (E) then Append (Copy_Entity (E), NL); else Append (Copy_Separate_Tree (E), NL); @@ -841,25 +1369,21 @@ package body Atree is end if; end Possible_Copy; + procedure Walk is new Walk_Sinfo_Fields_Pairwise (Possible_Copy); + -- Start of processing for Copy_Separate_Tree begin if Source <= Empty_Or_Error then return Source; - elsif Has_Extension (Source) then + elsif Is_Entity (Source) then return Copy_Entity (Source); else New_Id := New_Copy (Source); - -- Recursively copy descendants - - Set_Field1 (New_Id, Possible_Copy (Field1 (New_Id))); - Set_Field2 (New_Id, Possible_Copy (Field2 (New_Id))); - Set_Field3 (New_Id, Possible_Copy (Field3 (New_Id))); - Set_Field4 (New_Id, Possible_Copy (Field4 (New_Id))); - Set_Field5 (New_Id, Possible_Copy (Field5 (New_Id))); + Walk (New_Id, Source); -- Explicitly copy the aspect specifications as those do not reside -- in a node field. @@ -902,18 +1426,24 @@ package body Atree is -- binder, so we don't want to add that dependency. -- ??? Revisit now that ASIS is no longer using this unit. - -- Consequently we have no choice but to hold our noses and do - -- the change manually. At least we are Atree, so this odd use - -- of Atree.Unchecked_Access is at least all in the family. + -- Consequently we have no choice but to hold our noses and do the + -- change manually. At least we are Atree, so this is at least all + -- in the family. - -- Change the node type + -- Clear the Chars field which is not present in a selected + -- component node, so we don't want a junk value around. Note that + -- we can't just call Set_Chars, because Empty is of the wrong + -- type, and is outside the range of Name_Id. - Atree.Unchecked_Access.Set_Nkind (New_Id, N_Selected_Component); + Reinit_Field_To_Zero (New_Id, Chars); + Reinit_Field_To_Zero (New_Id, Has_Private_View); + Reinit_Field_To_Zero (New_Id, Is_Elaboration_Checks_OK_Node); + Reinit_Field_To_Zero (New_Id, Is_Elaboration_Warnings_OK_Node); + Reinit_Field_To_Zero (New_Id, Is_SPARK_Mode_On_Node); - -- Clear the Chars field which is not present in a selected - -- component node, so we don't want a junk value around. + -- Change the node type - Set_Node1 (New_Id, Empty); + Mutate_Nkind (New_Id, N_Selected_Component); end if; -- All done, return copied node @@ -922,58 +1452,25 @@ package body Atree is end if; end Copy_Separate_Tree; - ----------- - -- Ekind -- - ----------- - - function Ekind (E : Entity_Id) return Entity_Kind is - begin - pragma Assert (Nkind (E) in N_Entity); - return N_To_E (Nodes.Table (E + 1).Nkind); - end Ekind; - - ------------------ - -- Error_Posted -- - ------------------ - - function Error_Posted (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Error_Posted; - end Error_Posted; - ----------------------- -- Exchange_Entities -- ----------------------- procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id) is - Temp_Ent : Node_Record; - Temp_Flg : Flags_Byte; - - begin pragma Debug (New_Node_Debugging_Output (E1)); pragma Debug (New_Node_Debugging_Output (E2)); - pragma Assert (True - and then Has_Extension (E1) - and then Has_Extension (E2) - and then not Nodes.Table (E1).In_List - and then not Nodes.Table (E2).In_List); - - -- Exchange the contents of the two entities - - for J in 0 .. Num_Extension_Nodes loop - Temp_Ent := Nodes.Table (E1 + J); - Nodes.Table (E1 + J) := Nodes.Table (E2 + J); - Nodes.Table (E2 + J) := Temp_Ent; - end loop; + pragma Debug (Validate_Node_Write (E1)); + pragma Debug (Validate_Node_Write (E2)); + pragma Assert + (Is_Entity (E1) and then Is_Entity (E2) + and then not In_List (E1) and then not In_List (E2)); - -- Exchange flag bytes for first component. No need to do the exchange - -- for the other components, since the flag bytes are always zero. + Old_E1 : constant Node_Offset := Node_Offsets.Table (E1); - Temp_Flg := Flags.Table (E1); - Flags.Table (E1) := Flags.Table (E2); - Flags.Table (E2) := Temp_Flg; + begin + Node_Offsets.Table (E1) := Node_Offsets.Table (E2); + Node_Offsets.Table (E2) := Old_E1; -- That exchange exchanged the parent pointers as well, which is what -- we want, but we need to patch up the defining identifier pointers @@ -982,7 +1479,7 @@ package body Atree is -- case we don't do anything otherwise we won't be able to revert back -- to the original situation. - -- Shouldn't this use Is_Itype instead of the Parent test + -- Shouldn't this use Is_Itype instead of the Parent test??? if Present (Parent (E1)) and then Present (Parent (E2)) then Set_Defining_Identifier (Parent (E1), E1); @@ -994,67 +1491,27 @@ package body Atree is -- Extend_Node -- ----------------- - function Extend_Node (Source : Node_Id) return Entity_Id is + procedure Extend_Node (Source : Node_Id) is pragma Assert (Present (Source)); - pragma Assert (not Has_Extension (Source)); - New_Id : Entity_Id; - - procedure Debug_Extend_Node; - pragma Inline (Debug_Extend_Node); - -- Debug routine for -gnatdn - - ----------------------- - -- Debug_Extend_Node -- - ----------------------- - - procedure Debug_Extend_Node is - begin - if Debug_Flag_N then - Write_Str ("Extend node "); - Write_Int (Int (Source)); - - if New_Id = Source then - Write_Str (" in place"); - else - Write_Str (" copied to "); - Write_Int (Int (New_Id)); - end if; - - -- Write_Eol; - end if; - end Debug_Extend_Node; + pragma Assert (not Is_Entity (Source)); + + Old_Kind : constant Node_Kind := Nkind (Source); + New_Kind : constant Node_Kind := + (case Old_Kind is + when N_Character_Literal => N_Defining_Character_Literal, + when N_Identifier => N_Defining_Identifier, + when N_Operator_Symbol => N_Defining_Operator_Symbol, + when others => N_Abort_Statement); -- can't happen + -- The new NKind, which is the appropriate value of N_Entity based on + -- the old Nkind. N_xxx is mapped to N_Defining_xxx. + pragma Assert (New_Kind in N_Entity); -- Start of processing for Extend_Node begin - -- Optimize the case where Source happens to be the last node; in that - -- case, we don't need to move it. - - if Source = Nodes.Last then - New_Id := Source; - else - Nodes.Append (Nodes.Table (Source)); - Flags.Append (Flags.Table (Source)); - New_Id := Nodes.Last; - Orig_Nodes.Append (New_Id); - end if; - - Set_Check_Actuals (New_Id, False); - - -- Set extension nodes - - for J in 1 .. Num_Extension_Nodes loop - Nodes.Append (Default_Node_Extension); - Flags.Append (Default_Flags); - end loop; - - Orig_Nodes.Set_Last (Nodes.Last); - Allocate_List_Tables (Nodes.Last); - Report (Target => New_Id, Source => Source); - - pragma Debug (Debug_Extend_Node); - - return New_Id; + Set_Check_Actuals (Source, False); + Mutate_Nkind (Source, New_Kind); + Report (Target => Source, Source => Source); end Extend_Node; ----------------- @@ -1081,7 +1538,7 @@ package body Atree is if Field in Node_Range and then Present (Node_Id (Field)) - and then not Nodes.Table (Node_Id (Field)).In_List + and then not In_List (Node_Id (Field)) and then Parent (Node_Id (Field)) = Ref_Node then Set_Parent (Node_Id (Field), Fix_Node); @@ -1096,25 +1553,24 @@ package body Atree is end if; end Fix_Parent; + Fields : Node_Field_Array renames + Node_Field_Table (Nkind (Fix_Node)).all; + -- Start of processing for Fix_Parents begin - Fix_Parent (Field1 (Fix_Node)); - Fix_Parent (Field2 (Fix_Node)); - Fix_Parent (Field3 (Fix_Node)); - Fix_Parent (Field4 (Fix_Node)); - Fix_Parent (Field5 (Fix_Node)); + for J in Fields'Range loop + declare + Desc : Field_Descriptor renames + Node_Field_Descriptors (Fields (J)); + begin + if Desc.Kind in Node_Id_Field | List_Id_Field then + Fix_Parent (Get_Node_Field_Union (Fix_Node, Desc.Offset)); + end if; + end; + end loop; end Fix_Parents; - ------------------- - -- Flags_Address -- - ------------------- - - function Flags_Address return System.Address is - begin - return Flags.Table (First_Node_Id)'Address; - end Flags_Address; - ----------------------------------- -- Get_Comes_From_Source_Default -- ----------------------------------- @@ -1124,24 +1580,14 @@ package body Atree is return Comes_From_Source_Default; end Get_Comes_From_Source_Default; - ----------------- - -- Has_Aspects -- - ----------------- - - function Has_Aspects (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Has_Aspects; - end Has_Aspects; - - ------------------- - -- Has_Extension -- - ------------------- + --------------- + -- Is_Entity -- + --------------- - function Has_Extension (N : Node_Id) return Boolean is + function Is_Entity (N : Node_Id) return Boolean is begin - return N < Nodes.Last and then Nodes.Table (N + 1).Is_Extension; - end Has_Extension; + return Nkind (N) in N_Entity; + end Is_Entity; ---------------- -- Initialize -- @@ -1152,40 +1598,28 @@ package body Atree is pragma Warnings (Off, Dummy); begin - Atree_Private_Part.Nodes.Init; - Atree_Private_Part.Flags.Init; - Orig_Nodes.Init; - Paren_Counts.Init; - -- Allocate Empty node Dummy := New_Node (N_Empty, No_Location); - Set_Name1 (Empty, No_Name); + Set_Chars (Empty, No_Name); + pragma Assert (Dummy = Empty); -- Allocate Error node, and set Error_Posted, since we certainly -- only generate an Error node if we do post some kind of error. Dummy := New_Node (N_Error, No_Location); - Set_Name1 (Error, Error_Name); + Set_Chars (Error, Error_Name); Set_Error_Posted (Error, True); + pragma Assert (Dummy = Error); end Initialize; - --------------------------- - -- Is_Ignored_Ghost_Node -- - --------------------------- - - function Is_Ignored_Ghost_Node (N : Node_Id) return Boolean is - begin - return Flags.Table (N).Is_Ignored_Ghost_Node; - end Is_Ignored_Ghost_Node; - -------------------------- -- Is_Rewrite_Insertion -- -------------------------- function Is_Rewrite_Insertion (Node : Node_Id) return Boolean is begin - return Nodes.Table (Node).Rewrite_Ins; + return Rewrite_Ins (Node); end Is_Rewrite_Insertion; ----------------------------- @@ -1203,7 +1637,7 @@ package body Atree is function Last_Node_Id return Node_Id is begin - return Nodes.Last; + return Node_Offsets.Last; end Last_Node_Id; ---------- @@ -1212,14 +1646,6 @@ package body Atree is procedure Lock is begin - -- We used to Release the tables, as in the comments below, but that is - -- a waste of time. We're only wasting virtual memory here, and the - -- release calls copy large amounts of data. - -- ???Get rid of Release? - - -- Flags.Release; - Flags.Locked := True; - -- Orig_Nodes.Release; Orig_Nodes.Locked := True; end Lock; @@ -1239,6 +1665,8 @@ package body Atree is procedure Mark_New_Ghost_Node (N : Node_Or_Entity_Id) is begin + pragma Debug (Validate_Node_Write (N)); + -- The Ghost node is created within a Ghost region if Ghost_Mode = Check then @@ -1268,7 +1696,7 @@ package body Atree is procedure Mark_Rewrite_Insertion (New_Node : Node_Id) is begin - Nodes.Table (New_Node).Rewrite_Ins := True; + Set_Rewrite_Ins (New_Node); end Mark_Rewrite_Insertion; -------------- @@ -1276,41 +1704,34 @@ package body Atree is -------------- function New_Copy (Source : Node_Id) return Node_Id is + pragma Debug (Validate_Node (Source)); + New_Id : Node_Id; + S_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Source); begin if Source <= Empty_Or_Error then return Source; end if; - Nodes.Append (Nodes.Table (Source)); - Flags.Append (Flags.Table (Source)); - New_Id := Nodes.Last; + New_Id := Alloc_Node_Id; + Node_Offsets.Table (New_Id) := Alloc_Slots (S_Size); Orig_Nodes.Append (New_Id); + Copy_Slots (Source, New_Id); + Set_Check_Actuals (New_Id, False); Set_Paren_Count_Of_Copy (Target => New_Id, Source => Source); + pragma Assert (Original_Node (Node_Offsets.Last) = Node_Offsets.Last); - -- Set extension nodes if required - - if Has_Extension (Source) then - for J in 1 .. Num_Extension_Nodes loop - Nodes.Append (Nodes.Table (Source + J)); - Flags.Append (Flags.Table (Source + J)); - end loop; - Orig_Nodes.Set_Last (Nodes.Last); - else - pragma Assert (Orig_Nodes.Table (Orig_Nodes.Last) = Nodes.Last); - end if; - - Allocate_List_Tables (Nodes.Last); + Allocate_List_Tables (New_Id); Report (Target => New_Id, Source => Source); - Nodes.Table (New_Id).In_List := False; - Nodes.Table (New_Id).Link := Empty_List_Or_Node; + Set_In_List (New_Id, False); + Set_Link (New_Id, Empty_List_Or_Node); -- If the original is marked as a rewrite insertion, then unmark the -- copy, since we inserted the original, not the copy. - Nodes.Table (New_Id).Rewrite_Ins := False; + Set_Rewrite_Ins (New_Id, False); pragma Debug (New_Node_Debugging_Output (New_Id)); -- Clear Is_Overloaded since we cannot have semantic interpretations @@ -1342,17 +1763,9 @@ package body Atree is New_Sloc : Source_Ptr) return Entity_Id is pragma Assert (New_Node_Kind in N_Entity); - New_Id : constant Entity_Id := Allocate_New_Node; + New_Id : constant Entity_Id := Allocate_New_Node (New_Node_Kind); + pragma Assert (Original_Node (Node_Offsets.Last) = Node_Offsets.Last); begin - -- Set extension nodes - - for J in 1 .. Num_Extension_Nodes loop - Nodes.Append (Default_Node_Extension); - Flags.Append (Default_Flags); - end loop; - - Orig_Nodes.Set_Last (Nodes.Last); - -- If this is a node with a real location and we are generating -- source nodes, then reset Current_Error_Node. This is useful -- if we bomb during parsing to get a error location for the bomb. @@ -1361,8 +1774,7 @@ package body Atree is Current_Error_Node := New_Id; end if; - Nodes.Table (New_Id).Nkind := New_Node_Kind; - Nodes.Table (New_Id).Sloc := New_Sloc; + Set_Sloc (New_Id, New_Sloc); pragma Debug (New_Node_Debugging_Output (New_Id)); -- Mark the new entity as Ghost depending on the current Ghost region @@ -1381,11 +1793,10 @@ package body Atree is New_Sloc : Source_Ptr) return Node_Id is pragma Assert (New_Node_Kind not in N_Entity); - New_Id : constant Node_Id := Allocate_New_Node; - pragma Assert (Orig_Nodes.Table (Orig_Nodes.Last) = Nodes.Last); + New_Id : constant Node_Id := Allocate_New_Node (New_Node_Kind); + pragma Assert (Original_Node (Node_Offsets.Last) = Node_Offsets.Last); begin - Nodes.Table (New_Id).Nkind := New_Node_Kind; - Nodes.Table (New_Id).Sloc := New_Sloc; + Set_Sloc (New_Id, New_Sloc); pragma Debug (New_Node_Debugging_Output (New_Id)); -- If this is a node with a real location and we are generating source @@ -1431,15 +1842,6 @@ package body Atree is end if; end nnd; - ----------- - -- Nkind -- - ----------- - - function Nkind (N : Node_Id) return Node_Kind is - begin - return Nodes.Table (N).Nkind; - end Nkind; - -------- -- No -- -------- @@ -1476,10 +1878,23 @@ package body Atree is -- Nodes_Address -- ------------------- - function Nodes_Address return System.Address is + function Node_Offsets_Address return System.Address is begin - return Nodes.Table (First_Node_Id)'Address; - end Nodes_Address; + return Node_Offsets.Table (First_Node_Id)'Address; + end Node_Offsets_Address; + + Slot_Byte_Size : constant := 4; + pragma Assert (Slot_Byte_Size * 8 = Slot'Size); + + function Slots_Address return System.Address is + Extra : constant := Slots_Low_Bound * Slot_Byte_Size; + -- Slots does not start at 0, so we need to subtract off the extra + -- amount. We are returning Slots.Table (0)'Address, except that + -- that component does not exist. + use System.Storage_Elements; + begin + return Slots.Table (Slots_Low_Bound)'Address - Extra; + end Slots_Address; ----------------------------------- -- Approx_Num_Nodes_And_Entities -- @@ -1487,19 +1902,43 @@ package body Atree is function Approx_Num_Nodes_And_Entities return Nat is begin - -- This is an overestimate, because entities take up more space, but - -- that really doesn't matter; it's not worth subtracting out the - -- "extra". - - return Nat (Nodes.Last - First_Node_Id); + return Nat (Node_Offsets.Last - First_Node_Id); end Approx_Num_Nodes_And_Entities; + ----------- + -- Off_0 -- + ----------- + + function Off_0 (N : Node_Id) return Node_Offset is + pragma Debug (Validate_Node (N)); + + All_Node_Offsets : Node_Offsets.Table_Type renames + Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); + begin + return All_Node_Offsets (N); + end Off_0; + + ----------- + -- Off_L -- + ----------- + + function Off_L (N : Node_Id) return Node_Offset is + pragma Debug (Validate_Node (N)); + + All_Node_Offsets : Node_Offsets.Table_Type renames + Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); + begin + return All_Node_Offsets (N) + Size_In_Slots (N) - 1; + end Off_L; + ------------------- -- Original_Node -- ------------------- function Original_Node (Node : Node_Id) return Node_Id is begin + pragma Debug (Validate_Node (Node)); + return Orig_Nodes.Table (Node); end Original_Node; @@ -1508,19 +1947,11 @@ package body Atree is ----------------- function Paren_Count (N : Node_Id) return Nat is - C : Nat := 0; + pragma Debug (Validate_Node (N)); - begin - pragma Assert (N <= Nodes.Last); - - if Nodes.Table (N).Pflag1 then - C := C + 1; - end if; - - if Nodes.Table (N).Pflag2 then - C := C + 2; - end if; + C : constant Small_Paren_Count_Type := Small_Paren_Count (N); + begin -- Value of 0,1,2 returned as is if C <= 2 then @@ -1548,7 +1979,7 @@ package body Atree is if Is_List_Member (N) then return Parent (List_Containing (N)); else - return Node_Id (Nodes.Table (N).Link); + return Node_Id (Link (N)); end if; end Parent; @@ -1571,112 +2002,26 @@ package body Atree is end Preserve_Comes_From_Source; ---------------------- - -- Print_Statistics -- + -- Print_Atree_Info -- ---------------------- - procedure Print_Statistics is - N_Count : constant Natural := Natural (Nodes.Last - First_Node_Id + 1); - E_Count : Natural := 0; - + procedure Print_Atree_Info (N : Node_Or_Entity_Id) is + function Cast is new Unchecked_Conversion (Slot_32_Bit, Int); begin - Write_Str ("Number of entities: "); - Write_Eol; - - declare - function CP_Lt (Op1, Op2 : Natural) return Boolean; - -- Compare routine for Sort - - procedure CP_Move (From : Natural; To : Natural); - -- Move routine for Sort - - Kind_Count : array (Node_Kind) of Natural := (others => 0); - -- Array of occurrence count per node kind - - Kind_Max : constant Natural := Node_Kind'Pos (N_Unused_At_End) - 1; - -- The index of the largest (interesting) node kind - - Ranking : array (0 .. Kind_Max) of Node_Kind; - -- Ranking array for node kinds (index 0 is used for the temporary) - - package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt); - - function CP_Lt (Op1, Op2 : Natural) return Boolean is - begin - return Kind_Count (Ranking (Op2)) < Kind_Count (Ranking (Op1)); - end CP_Lt; - - procedure CP_Move (From : Natural; To : Natural) is - begin - Ranking (To) := Ranking (From); - end CP_Move; - - begin - -- Count the number of occurrences of each node kind - - for I in First_Node_Id .. Nodes.Last loop - declare - Nkind : constant Node_Kind := Nodes.Table (I).Nkind; - begin - if not Nodes.Table (I).Is_Extension then - Kind_Count (Nkind) := Kind_Count (Nkind) + 1; - end if; - end; - end loop; - - -- Sort the node kinds by number of occurrences - - for N in 1 .. Kind_Max loop - Ranking (N) := Node_Kind'Val (N); - end loop; - - Sorting.Sort (Kind_Max); - - -- Print the list in descending order - - for N in 1 .. Kind_Max loop - declare - Count : constant Natural := Kind_Count (Ranking (N)); - begin - if Count > 0 then - Write_Str (" "); - Write_Str (Node_Kind'Image (Ranking (N))); - Write_Str (": "); - Write_Int (Int (Count)); - Write_Eol; - - E_Count := E_Count + Count; - end if; - end; - end loop; - end; - - Write_Str ("Total number of entities: "); - Write_Int (Int (E_Count)); - Write_Eol; - - Write_Str ("Maximum number of nodes per entity: "); - Write_Int (Int (Num_Extension_Nodes + 1)); - Write_Eol; - - Write_Str ("Number of allocated nodes: "); - Write_Int (Int (N_Count)); - Write_Eol; + Write_Int (Int (Size_In_Slots (N))); + Write_Str (" slots ("); + Write_Int (Int (Off_0 (N))); + Write_Str (" .. "); + Write_Int (Int (Off_L (N))); + Write_Str ("):"); - Write_Str ("Ratio allocated nodes/entities: "); - Write_Int (Int (Long_Long_Integer (N_Count) * 100 / - Long_Long_Integer (E_Count))); - Write_Str ("/100"); - Write_Eol; - - Write_Str ("Size of a node in bytes: "); - Write_Int (Int (Node_Record'Size) / Storage_Unit); - Write_Eol; + for Off in Off_0 (N) .. Off_L (N) loop + Write_Str (" "); + Write_Int (Cast (Slots.Table (Off).Slot_32)); + end loop; - Write_Str ("Memory consumption in bytes: "); - Write_Int (Int (Long_Long_Integer (N_Count) * - (Node_Record'Size / Storage_Unit))); Write_Eol; - end Print_Statistics; + end Print_Atree_Info; ------------------- -- Relocate_Node -- @@ -1706,7 +2051,7 @@ package body Atree is -- then the relocated node has the same original node. if Is_Rewrite_Substitution (Source) then - Orig_Nodes.Table (New_Node) := Orig_Nodes.Table (Source); + Set_Original_Node (New_Node, Original_Node (Source)); end if; return New_Node; @@ -1717,35 +2062,47 @@ package body Atree is ------------- procedure Replace (Old_Node, New_Node : Node_Id) is - Old_Post : constant Boolean := Nodes.Table (Old_Node).Error_Posted; - Old_HasA : constant Boolean := Nodes.Table (Old_Node).Has_Aspects; - Old_CFS : constant Boolean := Nodes.Table (Old_Node).Comes_From_Source; + pragma Debug (New_Node_Debugging_Output (Old_Node)); + pragma Debug (New_Node_Debugging_Output (New_Node)); + + Old_Post : constant Boolean := Error_Posted (Old_Node); + Old_HasA : constant Boolean := Has_Aspects (Old_Node); + Old_CFS : constant Boolean := Comes_From_Source (Old_Node); + + procedure Destroy_New_Node; + -- Overwrite New_Node data with junk, for debugging purposes + + procedure Destroy_New_Node is + begin + Zero_Slots (New_Node); + Node_Offsets.Table (New_Node) := Field_Offset'Base'Last; + end Destroy_New_Node; begin pragma Assert - (not Has_Extension (Old_Node) - and not Has_Extension (New_Node) - and not Nodes.Table (New_Node).In_List); - - pragma Debug (New_Node_Debugging_Output (Old_Node)); - pragma Debug (New_Node_Debugging_Output (New_Node)); + (not Is_Entity (Old_Node) + and not Is_Entity (New_Node) + and not In_List (New_Node) + and Old_Node /= New_Node); -- Do copy, preserving link and in list status and required flags Copy_Node (Source => New_Node, Destination => Old_Node); - Nodes.Table (Old_Node).Comes_From_Source := Old_CFS; - Nodes.Table (Old_Node).Error_Posted := Old_Post; - Nodes.Table (Old_Node).Has_Aspects := Old_HasA; + Set_Comes_From_Source (Old_Node, Old_CFS); + Set_Error_Posted (Old_Node, Old_Post); + Set_Has_Aspects (Old_Node, Old_HasA); -- Fix parents of substituted node, since it has changed identity Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node); + pragma Debug (Destroy_New_Node); + -- Since we are doing a replace, we assume that the original node -- is intended to become the new replaced node. The call would be -- to Rewrite if there were an intention to save the original node. - Orig_Nodes.Table (Old_Node) := Old_Node; + Set_Original_Node (Old_Node, Old_Node); -- Invoke the reporting procedure (if available) @@ -1770,24 +2127,25 @@ package body Atree is ------------- procedure Rewrite (Old_Node, New_Node : Node_Id) is + pragma Debug (New_Node_Debugging_Output (Old_Node)); + pragma Debug (New_Node_Debugging_Output (New_Node)); - -- Flags table attributes - - Old_CA : constant Boolean := Flags.Table (Old_Node).Check_Actuals; - Old_Is_IGN : constant Boolean := - Flags.Table (Old_Node).Is_Ignored_Ghost_Node; - - -- Nodes table attributes - + Old_CA : constant Boolean := Check_Actuals (Old_Node); + Old_Is_IGN : constant Boolean := Is_Ignored_Ghost_Node (Old_Node); Old_Error_Posted : constant Boolean := - Nodes.Table (Old_Node).Error_Posted; + Error_Posted (Old_Node); Old_Has_Aspects : constant Boolean := - Nodes.Table (Old_Node).Has_Aspects; + Has_Aspects (Old_Node); - Old_Must_Not_Freeze : Boolean; - Old_Paren_Count : Nat; + Old_Must_Not_Freeze : constant Boolean := + (if Nkind (Old_Node) in N_Subexpr then Must_Not_Freeze (Old_Node) + else False); + Old_Paren_Count : constant Nat := + (if Nkind (Old_Node) in N_Subexpr then Paren_Count (Old_Node) else 0); -- These fields are preserved in the new node only if the new node and - -- the old node are both subexpression nodes. + -- the old node are both subexpression nodes. We might be changing Nkind + -- (Old_Node) from not N_Subexpr to N_Subexpr, so we need a value + -- (False/0) even if Old_Noed is not a N_Subexpr. -- Note: it is a violation of abstraction levels for Must_Not_Freeze -- to be referenced like this. ??? @@ -1796,20 +2154,9 @@ package body Atree is begin pragma Assert - (not Has_Extension (Old_Node) - and not Has_Extension (New_Node) - and not Nodes.Table (New_Node).In_List); - - pragma Debug (New_Node_Debugging_Output (Old_Node)); - pragma Debug (New_Node_Debugging_Output (New_Node)); - - if Nkind (Old_Node) in N_Subexpr then - Old_Must_Not_Freeze := Must_Not_Freeze (Old_Node); - Old_Paren_Count := Paren_Count (Old_Node); - else - Old_Must_Not_Freeze := False; - Old_Paren_Count := 0; - end if; + (not Is_Entity (Old_Node) + and not Is_Entity (New_Node) + and not In_List (New_Node)); -- Allocate a new node, to be used to preserve the original contents -- of the Old_Node, for possible later retrival by Original_Node and @@ -1817,10 +2164,10 @@ package body Atree is -- not already rewritten the node, as indicated by an Orig_Nodes entry -- that does not reference the Old_Node. - if Orig_Nodes.Table (Old_Node) = Old_Node then + if Original_Node (Old_Node) = Old_Node then Sav_Node := New_Copy (Old_Node); - Orig_Nodes.Table (Sav_Node) := Sav_Node; - Orig_Nodes.Table (Old_Node) := Sav_Node; + Set_Original_Node (Sav_Node, Sav_Node); + Set_Original_Node (Old_Node, Sav_Node); -- Both the old and new copies of the node will share the same list -- of aspect specifications if aspect specifications are present. @@ -1834,11 +2181,11 @@ package body Atree is -- Copy substitute node into place, preserving old fields as required Copy_Node (Source => New_Node, Destination => Old_Node); - Nodes.Table (Old_Node).Error_Posted := Old_Error_Posted; - Nodes.Table (Old_Node).Has_Aspects := Old_Has_Aspects; + Set_Error_Posted (Old_Node, Old_Error_Posted); + Set_Has_Aspects (Old_Node, Old_Has_Aspects); - Flags.Table (Old_Node).Check_Actuals := Old_CA; - Flags.Table (Old_Node).Is_Ignored_Ghost_Node := Old_Is_IGN; + Set_Check_Actuals (Old_Node, Old_CA); + Set_Is_Ignored_Ghost_Node (Old_Node, Old_Is_IGN); if Nkind (New_Node) in N_Subexpr then Set_Paren_Count (Old_Node, Old_Paren_Count); @@ -1860,37 +2207,6 @@ package body Atree is end if; end Rewrite; - ------------------ - -- Set_Analyzed -- - ------------------ - - procedure Set_Analyzed (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Analyzed := Val; - end Set_Analyzed; - - ----------------------- - -- Set_Check_Actuals -- - ----------------------- - - procedure Set_Check_Actuals (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (not Locked); - Flags.Table (N).Check_Actuals := Val; - end Set_Check_Actuals; - - --------------------------- - -- Set_Comes_From_Source -- - --------------------------- - - procedure Set_Comes_From_Source (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Comes_From_Source := Val; - end Set_Comes_From_Source; - ----------------------------------- -- Set_Comes_From_Source_Default -- ----------------------------------- @@ -1900,38 +2216,6 @@ package body Atree is Comes_From_Source_Default := Default; end Set_Comes_From_Source_Default; - --------------- - -- Set_Ekind -- - --------------- - - procedure Set_Ekind (E : Entity_Id; Val : Entity_Kind) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (E) in N_Entity); - Nodes.Table (E + 1).Nkind := E_To_N (Val); - end Set_Ekind; - - ---------------------- - -- Set_Error_Posted -- - ---------------------- - - procedure Set_Error_Posted (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Error_Posted := Val; - end Set_Error_Posted; - - --------------------- - -- Set_Has_Aspects -- - --------------------- - - procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Has_Aspects := Val; - end Set_Has_Aspects; - -------------------------------------- -- Set_Ignored_Ghost_Recording_Proc -- -------------------------------------- @@ -1944,23 +2228,14 @@ package body Atree is Ignored_Ghost_Recording_Proc := Proc; end Set_Ignored_Ghost_Recording_Proc; - ------------------------------- - -- Set_Is_Ignored_Ghost_Node -- - ------------------------------- - - procedure Set_Is_Ignored_Ghost_Node (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (not Locked); - Flags.Table (N).Is_Ignored_Ghost_Node := Val; - end Set_Is_Ignored_Ghost_Node; - ----------------------- -- Set_Original_Node -- ----------------------- procedure Set_Original_Node (N : Node_Id; Val : Node_Id) is begin - pragma Assert (not Locked); + pragma Debug (Validate_Node_Write (N)); + Orig_Nodes.Table (N) := Val; end Set_Original_Node; @@ -1970,20 +2245,18 @@ package body Atree is procedure Set_Paren_Count (N : Node_Id; Val : Nat) is begin - pragma Assert (not Locked); + pragma Debug (Validate_Node_Write (N)); pragma Assert (Nkind (N) in N_Subexpr); -- Value of 0,1,2 stored as is if Val <= 2 then - Nodes.Table (N).Pflag1 := (Val mod 2 /= 0); - Nodes.Table (N).Pflag2 := (Val = 2); + Set_Small_Paren_Count (N, Val); -- Value of 3 or greater stores 3 in node and makes table entry else - Nodes.Table (N).Pflag1 := True; - Nodes.Table (N).Pflag2 := True; + Set_Small_Paren_Count (N, 3); -- Search for existing table entry @@ -2006,11 +2279,11 @@ package body Atree is procedure Set_Paren_Count_Of_Copy (Target, Source : Node_Id) is begin - -- We already copied the two Pflags. We need to update the Paren_Counts - -- table only if greater than 2. + -- We already copied the Small_Paren_Count. We need to update the + -- Paren_Counts table only if greater than 2. if Nkind (Source) in N_Subexpr - and then Paren_Count (Source) > 2 + and then Small_Paren_Count (Source) = 3 then Set_Paren_Count (Target, Paren_Count (Source)); end if; @@ -2025,8 +2298,8 @@ package body Atree is procedure Set_Parent (N : Node_Id; Val : Node_Id) is begin pragma Assert (not Locked); - pragma Assert (not Nodes.Table (N).In_List); - Nodes.Table (N).Link := Union_Id (Val); + pragma Assert (not In_List (N)); + Set_Link (N, Union_Id (Val)); end Set_Parent; ------------------------ @@ -2039,16 +2312,6 @@ package body Atree is Reporting_Proc := Proc; end Set_Reporting_Proc; - -------------- - -- Set_Sloc -- - -------------- - - procedure Set_Sloc (N : Node_Id; Val : Source_Ptr) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Sloc := Val; - end Set_Sloc; - ------------------------ -- Set_Rewriting_Proc -- ------------------------ @@ -2059,91 +2322,74 @@ package body Atree is Rewriting_Proc := Proc; end Set_Rewriting_Proc; - ---------- - -- Sloc -- - ---------- + function Size_In_Slots_To_Alloc (Kind : Node_Kind) return Field_Offset is + begin + return + (if Kind in N_Entity then Einfo.Entities.Max_Entity_Size + else Sinfo.Nodes.Size (Kind)); + -- Unfortunately, we don't know the Entity_Kind, so we have to use the + -- max. + end Size_In_Slots_To_Alloc; - function Sloc (N : Node_Id) return Source_Ptr is + function Size_In_Slots_To_Alloc + (N : Node_Or_Entity_Id) return Field_Offset is begin - return Nodes.Table (N).Sloc; - end Sloc; + return Size_In_Slots_To_Alloc (Nkind (N)); + end Size_In_Slots_To_Alloc; + + function Size_In_Slots (N : Node_Or_Entity_Id) return Field_Offset is + begin + return + (if Nkind (N) in N_Entity then Einfo.Entities.Max_Entity_Size + else Sinfo.Nodes.Size (Nkind (N))); + end Size_In_Slots; ------------------- -- Traverse_Func -- ------------------- function Traverse_Func (Node : Node_Id) return Traverse_Final_Result is + pragma Debug (Validate_Node (Node)); - function Traverse_Field - (Nod : Node_Id; - Fld : Union_Id; - FN : Field_Num) return Traverse_Final_Result; - -- Fld is one of the fields of Nod. If the field points to syntactic - -- node or list, then this node or list is traversed, and the result is - -- the result of this traversal. Otherwise a value of True is returned - -- with no processing. FN is the number of the field (1 .. 5). + function Traverse_Field (Fld : Union_Id) return Traverse_Final_Result; + -- Fld is one of the Traversed fields of Nod, which is necessarily a + -- Node_Id or List_Id. It is traversed, and the result is the result of + -- this traversal. -------------------- -- Traverse_Field -- -------------------- - function Traverse_Field - (Nod : Node_Id; - Fld : Union_Id; - FN : Field_Num) return Traverse_Final_Result - is + function Traverse_Field (Fld : Union_Id) return Traverse_Final_Result is begin - if Fld = Union_Id (Empty) then - return OK; - - -- Descendant is a node + if Fld /= Union_Id (Empty) then - elsif Fld in Node_Range then + -- Descendant is a node - -- Traverse descendant that is syntactic subtree node - - if Is_Syntactic_Field (Nkind (Nod), FN) then + if Fld in Node_Range then return Traverse_Func (Node_Id (Fld)); - -- Node that is not a syntactic subtree - - else - return OK; - end if; - - -- Descendant is a list - - elsif Fld in List_Range then - - -- Traverse descendant that is a syntactic subtree list + -- Descendant is a list - if Is_Syntactic_Field (Nkind (Nod), FN) then + elsif Fld in List_Range then declare Elmt : Node_Id := First (List_Id (Fld)); - begin while Present (Elmt) loop if Traverse_Func (Elmt) = Abandon then return Abandon; - else - Next (Elmt); end if; - end loop; - return OK; + Next (Elmt); + end loop; end; - -- List that is not a syntactic subtree - else - return OK; + raise Program_Error; end if; - - -- Field was not a node or a list - - else - return OK; end if; + + return OK; end Traverse_Field; Cur_Node : Node_Id := Node; @@ -2151,12 +2397,19 @@ package body Atree is -- Start of processing for Traverse_Func begin - -- We walk Field2 last, and if it is a node, we eliminate the tail - -- recursion by jumping back to this label. This is because Field2 is - -- where the Left_Opnd field of N_Op_Concat is stored, and in practice - -- concatenations are sometimes deeply nested, as in X1&X2&...&XN. This - -- trick prevents us from running out of memory in that case. We don't - -- bother eliminating the tail recursion if Field2 is a list. + -- If the last field is a node, we eliminate the tail recursion by + -- jumping back to this label. This is because concatenations are + -- sometimes deeply nested, as in X1&X2&...&Xn. Gen_IL ensures that the + -- Left_Opnd field of N_Op_Concat comes last in Traversed_Fields, so the + -- tail recursion is eliminated in that case. This trick prevents us + -- from running out of stack memory in that case. We don't bother + -- eliminating the tail recursion if the last field is a list. + -- + -- (To check, look in the body of Sinfo.Nodes, search for the Left_Opnd + -- getter, and note the offset of Left_Opnd. Then look in the spec of + -- Sinfo.Nodes, look at the Traversed_Fields table, search for the + -- N_Op_Concat component. The offset of Left_Opnd should be the last + -- component before the No_Field_Offset sentinels.) <<Tail_Recurse>> @@ -2174,30 +2427,51 @@ package body Atree is Cur_Node := Original_Node (Cur_Node); end case; - if Traverse_Field (Cur_Node, Field1 (Cur_Node), 1) = Abandon - or else -- skip Field2 here - Traverse_Field (Cur_Node, Field3 (Cur_Node), 3) = Abandon - or else - Traverse_Field (Cur_Node, Field4 (Cur_Node), 4) = Abandon - or else - Traverse_Field (Cur_Node, Field5 (Cur_Node), 5) = Abandon - then - return Abandon; - end if; + -- Check for empty Traversed_Fields before entering loop below, so the + -- tail recursive step won't go past the end. - if Field2 (Cur_Node) not in Node_Range then - return Traverse_Field (Cur_Node, Field2 (Cur_Node), 2); + declare + Cur_Field : Offset_Array_Index := Traversed_Offset_Array'First; + Offsets : Traversed_Offset_Array renames + Traversed_Fields (Nkind (Cur_Node)); - elsif Is_Syntactic_Field (Nkind (Cur_Node), 2) - and then Field2 (Cur_Node) /= Empty_List_Or_Node - then - -- Here is the tail recursion step, we reset Cur_Node and jump back - -- to the start of the procedure, which has the same semantic effect - -- as a call. + begin + if Offsets (Traversed_Offset_Array'First) /= No_Field_Offset then + while Offsets (Cur_Field + 1) /= No_Field_Offset loop + declare + F : constant Union_Id := + Get_Node_Field_Union (Cur_Node, Offsets (Cur_Field)); - Cur_Node := Node_Id (Field2 (Cur_Node)); - goto Tail_Recurse; - end if; + begin + if Traverse_Field (F) = Abandon then + return Abandon; + end if; + end; + + Cur_Field := Cur_Field + 1; + end loop; + + declare + F : constant Union_Id := + Get_Node_Field_Union (Cur_Node, Offsets (Cur_Field)); + + begin + if F not in Node_Range then + if Traverse_Field (F) = Abandon then + return Abandon; + end if; + + elsif F /= Empty_List_Or_Node then + -- Here is the tail recursion step, we reset Cur_Node and + -- jump back to the start of the procedure, which has the + -- same semantic effect as a call. + + Cur_Node := Node_Id (F); + goto Tail_Recurse; + end if; + end; + end if; + end; return OK; end Traverse_Func; @@ -2214,6573 +2488,12 @@ package body Atree is Discard := Traverse (Node); end Traverse_Proc; - ------------------------------ - -- Unchecked Access Package -- - ------------------------------ - - package body Unchecked_Access is - - function Field1 (N : Node_Id) return Union_Id is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Field1; - end Field1; - - function Field2 (N : Node_Id) return Union_Id is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Field2; - end Field2; - - function Field3 (N : Node_Id) return Union_Id is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Field3; - end Field3; - - function Field4 (N : Node_Id) return Union_Id is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Field4; - end Field4; - - function Field5 (N : Node_Id) return Union_Id is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Field5; - end Field5; - - function Field6 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Field6; - end Field6; - - function Field7 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Field7; - end Field7; - - function Field8 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Field8; - end Field8; - - function Field9 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Field9; - end Field9; - - function Field10 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Field10; - end Field10; - - function Field11 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Field11; - end Field11; - - function Field12 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Field12; - end Field12; - - function Field13 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Field6; - end Field13; - - function Field14 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Field7; - end Field14; - - function Field15 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Field8; - end Field15; - - function Field16 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Field9; - end Field16; - - function Field17 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Field10; - end Field17; - - function Field18 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Field11; - end Field18; - - function Field19 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Field6; - end Field19; - - function Field20 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Field7; - end Field20; - - function Field21 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Field8; - end Field21; - - function Field22 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Field9; - end Field22; - - function Field23 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Field10; - end Field23; - - function Field24 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Field6; - end Field24; - - function Field25 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Field7; - end Field25; - - function Field26 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Field8; - end Field26; - - function Field27 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Field9; - end Field27; - - function Field28 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Field10; - end Field28; - - function Field29 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Field11; - end Field29; - - function Field30 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Field6; - end Field30; - - function Field31 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Field7; - end Field31; - - function Field32 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Field8; - end Field32; - - function Field33 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Field9; - end Field33; - - function Field34 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Field10; - end Field34; - - function Field35 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Field11; - end Field35; - - function Field36 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 6).Field6; - end Field36; - - function Field37 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 6).Field7; - end Field37; - - function Field38 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 6).Field8; - end Field38; - - function Field39 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 6).Field9; - end Field39; - - function Field40 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 6).Field10; - end Field40; - - function Field41 (N : Node_Id) return Union_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 6).Field11; - end Field41; - - function Node1 (N : Node_Id) return Node_Id is - begin - pragma Assert (N <= Nodes.Last); - return Node_Id (Nodes.Table (N).Field1); - end Node1; - - function Node2 (N : Node_Id) return Node_Id is - begin - pragma Assert (N <= Nodes.Last); - return Node_Id (Nodes.Table (N).Field2); - end Node2; - - function Node3 (N : Node_Id) return Node_Id is - begin - pragma Assert (N <= Nodes.Last); - return Node_Id (Nodes.Table (N).Field3); - end Node3; - - function Node4 (N : Node_Id) return Node_Id is - begin - pragma Assert (N <= Nodes.Last); - return Node_Id (Nodes.Table (N).Field4); - end Node4; - - function Node5 (N : Node_Id) return Node_Id is - begin - pragma Assert (N <= Nodes.Last); - return Node_Id (Nodes.Table (N).Field5); - end Node5; - - function Node6 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 1).Field6); - end Node6; - - function Node7 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 1).Field7); - end Node7; - - function Node8 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 1).Field8); - end Node8; - - function Node9 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 1).Field9); - end Node9; - - function Node10 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 1).Field10); - end Node10; - - function Node11 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 1).Field11); - end Node11; - - function Node12 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 1).Field12); - end Node12; - - function Node13 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 2).Field6); - end Node13; - - function Node14 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 2).Field7); - end Node14; - - function Node15 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 2).Field8); - end Node15; - - function Node16 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 2).Field9); - end Node16; - - function Node17 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 2).Field10); - end Node17; - - function Node18 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 2).Field11); - end Node18; - - function Node19 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 3).Field6); - end Node19; - - function Node20 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 3).Field7); - end Node20; - - function Node21 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 3).Field8); - end Node21; - - function Node22 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 3).Field9); - end Node22; - - function Node23 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 3).Field10); - end Node23; - - function Node24 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 4).Field6); - end Node24; - - function Node25 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 4).Field7); - end Node25; - - function Node26 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 4).Field8); - end Node26; - - function Node27 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 4).Field9); - end Node27; - - function Node28 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 4).Field10); - end Node28; - - function Node29 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 4).Field11); - end Node29; - - function Node30 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 5).Field6); - end Node30; - - function Node31 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 5).Field7); - end Node31; - - function Node32 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 5).Field8); - end Node32; - - function Node33 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 5).Field9); - end Node33; - - function Node34 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 5).Field10); - end Node34; - - function Node35 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 5).Field11); - end Node35; - - function Node36 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 6).Field6); - end Node36; - - function Node37 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 6).Field7); - end Node37; - - function Node38 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 6).Field8); - end Node38; - - function Node39 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 6).Field9); - end Node39; - - function Node40 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 6).Field10); - end Node40; - - function Node41 (N : Node_Id) return Node_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return Node_Id (Nodes.Table (N + 6).Field11); - end Node41; - - function List1 (N : Node_Id) return List_Id is - begin - pragma Assert (N <= Nodes.Last); - return List_Id (Nodes.Table (N).Field1); - end List1; - - function List2 (N : Node_Id) return List_Id is - begin - pragma Assert (N <= Nodes.Last); - return List_Id (Nodes.Table (N).Field2); - end List2; - - function List3 (N : Node_Id) return List_Id is - begin - pragma Assert (N <= Nodes.Last); - return List_Id (Nodes.Table (N).Field3); - end List3; - - function List4 (N : Node_Id) return List_Id is - begin - pragma Assert (N <= Nodes.Last); - return List_Id (Nodes.Table (N).Field4); - end List4; - - function List5 (N : Node_Id) return List_Id is - begin - pragma Assert (N <= Nodes.Last); - return List_Id (Nodes.Table (N).Field5); - end List5; - - function List10 (N : Node_Id) return List_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return List_Id (Nodes.Table (N + 1).Field10); - end List10; - - function List14 (N : Node_Id) return List_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return List_Id (Nodes.Table (N + 2).Field7); - end List14; - - function List25 (N : Node_Id) return List_Id is - begin - pragma Assert (Nkind (N) in N_Entity); - return List_Id (Nodes.Table (N + 4).Field7); - end List25; - - function List38 (N : Node_Id) return List_Id is - begin - return List_Id (Nodes.Table (N + 6).Field8); - end List38; - - function List39 (N : Node_Id) return List_Id is - begin - return List_Id (Nodes.Table (N + 6).Field9); - end List39; - - function Elist1 (N : Node_Id) return Elist_Id is - pragma Assert (N <= Nodes.Last); - Value : constant Union_Id := Nodes.Table (N).Field1; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist1; - - function Elist2 (N : Node_Id) return Elist_Id is - pragma Assert (N <= Nodes.Last); - Value : constant Union_Id := Nodes.Table (N).Field2; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist2; - - function Elist3 (N : Node_Id) return Elist_Id is - pragma Assert (N <= Nodes.Last); - Value : constant Union_Id := Nodes.Table (N).Field3; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist3; - - function Elist4 (N : Node_Id) return Elist_Id is - pragma Assert (N <= Nodes.Last); - Value : constant Union_Id := Nodes.Table (N).Field4; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist4; - - function Elist5 (N : Node_Id) return Elist_Id is - pragma Assert (N <= Nodes.Last); - Value : constant Union_Id := Nodes.Table (N).Field5; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist5; - - function Elist8 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 1).Field8; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist8; - - function Elist9 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 1).Field9; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist9; - - function Elist10 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 1).Field10; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist10; - - function Elist11 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 1).Field11; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist11; - - function Elist13 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 2).Field6; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist13; - - function Elist15 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 2).Field8; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist15; - - function Elist16 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 2).Field9; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist16; - - function Elist18 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 2).Field11; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist18; - - function Elist21 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 3).Field8; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist21; - - function Elist23 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 3).Field10; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist23; - - function Elist24 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 4).Field6; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist24; - - function Elist25 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 4).Field7; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist25; - - function Elist26 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 4).Field8; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist26; - - function Elist29 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 4).Field11; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist29; - - function Elist30 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 5).Field6; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist30; - - function Elist36 (N : Node_Id) return Elist_Id is - pragma Assert (Nkind (N) in N_Entity); - Value : constant Union_Id := Nodes.Table (N + 6).Field6; - begin - if Value = 0 then - return No_Elist; - else - return Elist_Id (Value); - end if; - end Elist36; - - function Name1 (N : Node_Id) return Name_Id is - begin - pragma Assert (N <= Nodes.Last); - return Name_Id (Nodes.Table (N).Field1); - end Name1; - - function Name2 (N : Node_Id) return Name_Id is - begin - pragma Assert (N <= Nodes.Last); - return Name_Id (Nodes.Table (N).Field2); - end Name2; - - function Str3 (N : Node_Id) return String_Id is - begin - pragma Assert (N <= Nodes.Last); - return String_Id (Nodes.Table (N).Field3); - end Str3; - - function Uint2 (N : Node_Id) return Uint is - pragma Assert (N <= Nodes.Last); - U : constant Union_Id := Nodes.Table (N).Field2; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint2; - - function Uint3 (N : Node_Id) return Uint is - pragma Assert (N <= Nodes.Last); - U : constant Union_Id := Nodes.Table (N).Field3; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint3; - - function Uint4 (N : Node_Id) return Uint is - pragma Assert (N <= Nodes.Last); - U : constant Union_Id := Nodes.Table (N).Field4; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint4; - - function Uint5 (N : Node_Id) return Uint is - pragma Assert (N <= Nodes.Last); - U : constant Union_Id := Nodes.Table (N).Field5; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint5; - - function Uint8 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 1).Field8; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint8; - - function Uint9 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 1).Field9; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint9; - - function Uint10 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 1).Field10; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint10; - - function Uint11 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 1).Field11; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint11; - - function Uint12 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 1).Field12; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint12; - - function Uint13 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 2).Field6; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint13; - - function Uint14 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 2).Field7; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint14; - - function Uint15 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 2).Field8; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint15; - - function Uint16 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 2).Field9; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint16; - - function Uint17 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 2).Field10; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint17; - - function Uint22 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 3).Field9; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint22; - - function Uint24 (N : Node_Id) return Uint is - pragma Assert (Nkind (N) in N_Entity); - U : constant Union_Id := Nodes.Table (N + 4).Field6; - begin - if U = 0 then - return Uint_0; - else - return From_Union (U); - end if; - end Uint24; - - function Ureal3 (N : Node_Id) return Ureal is - begin - pragma Assert (N <= Nodes.Last); - return From_Union (Nodes.Table (N).Field3); - end Ureal3; - - function Ureal18 (N : Node_Id) return Ureal is - begin - pragma Assert (Nkind (N) in N_Entity); - return From_Union (Nodes.Table (N + 2).Field11); - end Ureal18; - - function Ureal21 (N : Node_Id) return Ureal is - begin - pragma Assert (Nkind (N) in N_Entity); - return From_Union (Nodes.Table (N + 3).Field8); - end Ureal21; - - function Flag0 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Flags.Table (N).Flag0; - end Flag0; - - function Flag1 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Flags.Table (N).Flag1; - end Flag1; - - function Flag2 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Flags.Table (N).Flag2; - end Flag2; - - function Flag3 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Flags.Table (N).Flag3; - end Flag3; - - function Flag4 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag4; - end Flag4; - - function Flag5 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag5; - end Flag5; - - function Flag6 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag6; - end Flag6; - - function Flag7 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag7; - end Flag7; - - function Flag8 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag8; - end Flag8; - - function Flag9 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag9; - end Flag9; - - function Flag10 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag10; - end Flag10; - - function Flag11 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag11; - end Flag11; - - function Flag12 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag12; - end Flag12; - - function Flag13 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag13; - end Flag13; - - function Flag14 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag14; - end Flag14; - - function Flag15 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag15; - end Flag15; - - function Flag16 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag16; - end Flag16; - - function Flag17 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag17; - end Flag17; - - function Flag18 (N : Node_Id) return Boolean is - begin - pragma Assert (N <= Nodes.Last); - return Nodes.Table (N).Flag18; - end Flag18; - - function Flag19 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).In_List; - end Flag19; - - function Flag20 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Has_Aspects; - end Flag20; - - function Flag21 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Rewrite_Ins; - end Flag21; - - function Flag22 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Analyzed; - end Flag22; - - function Flag23 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Comes_From_Source; - end Flag23; - - function Flag24 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Error_Posted; - end Flag24; - - function Flag25 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag4; - end Flag25; - - function Flag26 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag5; - end Flag26; - - function Flag27 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag6; - end Flag27; - - function Flag28 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag7; - end Flag28; - - function Flag29 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag8; - end Flag29; - - function Flag30 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag9; - end Flag30; - - function Flag31 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag10; - end Flag31; - - function Flag32 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag11; - end Flag32; - - function Flag33 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag12; - end Flag33; - - function Flag34 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag13; - end Flag34; - - function Flag35 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag14; - end Flag35; - - function Flag36 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag15; - end Flag36; - - function Flag37 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag16; - end Flag37; - - function Flag38 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag17; - end Flag38; - - function Flag39 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Flag18; - end Flag39; - - function Flag40 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).In_List; - end Flag40; - - function Flag41 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Has_Aspects; - end Flag41; - - function Flag42 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Rewrite_Ins; - end Flag42; - - function Flag43 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Analyzed; - end Flag43; - - function Flag44 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Comes_From_Source; - end Flag44; - - function Flag45 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Error_Posted; - end Flag45; - - function Flag46 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag4; - end Flag46; - - function Flag47 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag5; - end Flag47; - - function Flag48 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag6; - end Flag48; - - function Flag49 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag7; - end Flag49; - - function Flag50 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag8; - end Flag50; - - function Flag51 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag9; - end Flag51; - - function Flag52 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag10; - end Flag52; - - function Flag53 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag11; - end Flag53; - - function Flag54 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag12; - end Flag54; - - function Flag55 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag13; - end Flag55; - - function Flag56 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag14; - end Flag56; - - function Flag57 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag15; - end Flag57; - - function Flag58 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag16; - end Flag58; - - function Flag59 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag17; - end Flag59; - - function Flag60 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Flag18; - end Flag60; - - function Flag61 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Pflag1; - end Flag61; - - function Flag62 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Pflag2; - end Flag62; - - function Flag63 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Pflag1; - end Flag63; - - function Flag64 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Pflag2; - end Flag64; - - function Flag65 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag65; - end Flag65; - - function Flag66 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag66; - end Flag66; - - function Flag67 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag67; - end Flag67; - - function Flag68 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag68; - end Flag68; - - function Flag69 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag69; - end Flag69; - - function Flag70 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag70; - end Flag70; - - function Flag71 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag71; - end Flag71; - - function Flag72 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte (Nodes.Table (N + 2).Nkind).Flag72; - end Flag72; - - function Flag73 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag73; - end Flag73; - - function Flag74 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag74; - end Flag74; - - function Flag75 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag75; - end Flag75; - - function Flag76 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag76; - end Flag76; - - function Flag77 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag77; - end Flag77; - - function Flag78 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag78; - end Flag78; - - function Flag79 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag79; - end Flag79; - - function Flag80 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag80; - end Flag80; - - function Flag81 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag81; - end Flag81; - - function Flag82 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag82; - end Flag82; - - function Flag83 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag83; - end Flag83; - - function Flag84 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag84; - end Flag84; - - function Flag85 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag85; - end Flag85; - - function Flag86 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag86; - end Flag86; - - function Flag87 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag87; - end Flag87; - - function Flag88 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag88; - end Flag88; - - function Flag89 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag89; - end Flag89; - - function Flag90 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag90; - end Flag90; - - function Flag91 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag91; - end Flag91; - - function Flag92 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag92; - end Flag92; - - function Flag93 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag93; - end Flag93; - - function Flag94 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag94; - end Flag94; - - function Flag95 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag95; - end Flag95; - - function Flag96 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word (Nodes.Table (N + 2).Field12).Flag96; - end Flag96; - - function Flag97 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag97; - end Flag97; - - function Flag98 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag98; - end Flag98; - - function Flag99 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag99; - end Flag99; - - function Flag100 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag100; - end Flag100; - - function Flag101 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag101; - end Flag101; - - function Flag102 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag102; - end Flag102; - - function Flag103 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag103; - end Flag103; - - function Flag104 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag104; - end Flag104; - - function Flag105 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag105; - end Flag105; - - function Flag106 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag106; - end Flag106; - - function Flag107 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag107; - end Flag107; - - function Flag108 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag108; - end Flag108; - - function Flag109 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag109; - end Flag109; - - function Flag110 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag110; - end Flag110; - - function Flag111 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag111; - end Flag111; - - function Flag112 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag112; - end Flag112; - - function Flag113 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag113; - end Flag113; - - function Flag114 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag114; - end Flag114; - - function Flag115 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag115; - end Flag115; - - function Flag116 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag116; - end Flag116; - - function Flag117 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag117; - end Flag117; - - function Flag118 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag118; - end Flag118; - - function Flag119 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag119; - end Flag119; - - function Flag120 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag120; - end Flag120; - - function Flag121 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag121; - end Flag121; - - function Flag122 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag122; - end Flag122; - - function Flag123 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag123; - end Flag123; - - function Flag124 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag124; - end Flag124; - - function Flag125 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag125; - end Flag125; - - function Flag126 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag126; - end Flag126; - - function Flag127 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag127; - end Flag127; - - function Flag128 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word2 (Nodes.Table (N + 3).Field12).Flag128; - end Flag128; - - function Flag129 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).In_List; - end Flag129; - - function Flag130 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Has_Aspects; - end Flag130; - - function Flag131 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Rewrite_Ins; - end Flag131; - - function Flag132 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Analyzed; - end Flag132; - - function Flag133 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Comes_From_Source; - end Flag133; - - function Flag134 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Error_Posted; - end Flag134; - - function Flag135 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag4; - end Flag135; - - function Flag136 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag5; - end Flag136; - - function Flag137 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag6; - end Flag137; - - function Flag138 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag7; - end Flag138; - - function Flag139 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag8; - end Flag139; - - function Flag140 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag9; - end Flag140; - - function Flag141 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag10; - end Flag141; - - function Flag142 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag11; - end Flag142; - - function Flag143 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag12; - end Flag143; - - function Flag144 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag13; - end Flag144; - - function Flag145 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag14; - end Flag145; - - function Flag146 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag15; - end Flag146; - - function Flag147 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag16; - end Flag147; - - function Flag148 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag17; - end Flag148; - - function Flag149 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Flag18; - end Flag149; - - function Flag150 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Pflag1; - end Flag150; - - function Flag151 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Pflag2; - end Flag151; - - function Flag152 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag152; - end Flag152; - - function Flag153 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag153; - end Flag153; - - function Flag154 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag154; - end Flag154; - - function Flag155 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag155; - end Flag155; - - function Flag156 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag156; - end Flag156; - - function Flag157 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag157; - end Flag157; - - function Flag158 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag158; - end Flag158; - - function Flag159 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag159; - end Flag159; - - function Flag160 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag160; - end Flag160; - - function Flag161 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag161; - end Flag161; - - function Flag162 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag162; - end Flag162; - - function Flag163 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag163; - end Flag163; - - function Flag164 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag164; - end Flag164; - - function Flag165 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag165; - end Flag165; - - function Flag166 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag166; - end Flag166; - - function Flag167 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag167; - end Flag167; - - function Flag168 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag168; - end Flag168; - - function Flag169 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag169; - end Flag169; - - function Flag170 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag170; - end Flag170; - - function Flag171 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag171; - end Flag171; - - function Flag172 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag172; - end Flag172; - - function Flag173 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag173; - end Flag173; - - function Flag174 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag174; - end Flag174; - - function Flag175 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag175; - end Flag175; - - function Flag176 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag176; - end Flag176; - - function Flag177 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag177; - end Flag177; - - function Flag178 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag178; - end Flag178; - - function Flag179 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag179; - end Flag179; - - function Flag180 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag180; - end Flag180; - - function Flag181 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag181; - end Flag181; - - function Flag182 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag182; - end Flag182; - - function Flag183 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word3 (Nodes.Table (N + 3).Field11).Flag183; - end Flag183; - - function Flag184 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag184; - end Flag184; - - function Flag185 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag185; - end Flag185; - - function Flag186 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag186; - end Flag186; - - function Flag187 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag187; - end Flag187; - - function Flag188 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag188; - end Flag188; - - function Flag189 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag189; - end Flag189; - - function Flag190 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag190; - end Flag190; - - function Flag191 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag191; - end Flag191; - - function Flag192 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag192; - end Flag192; - - function Flag193 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag193; - end Flag193; - - function Flag194 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag194; - end Flag194; - - function Flag195 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag195; - end Flag195; - - function Flag196 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag196; - end Flag196; - - function Flag197 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag197; - end Flag197; - - function Flag198 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag198; - end Flag198; - - function Flag199 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag199; - end Flag199; - - function Flag200 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag200; - end Flag200; - - function Flag201 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag201; - end Flag201; - - function Flag202 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag202; - end Flag202; - - function Flag203 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag203; - end Flag203; - - function Flag204 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag204; - end Flag204; - - function Flag205 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag205; - end Flag205; - - function Flag206 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag206; - end Flag206; - - function Flag207 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag207; - end Flag207; - - function Flag208 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag208; - end Flag208; - - function Flag209 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag209; - end Flag209; - - function Flag210 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag210; - end Flag210; - - function Flag211 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag211; - end Flag211; - - function Flag212 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag212; - end Flag212; - - function Flag213 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag213; - end Flag213; - - function Flag214 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag214; - end Flag214; - - function Flag215 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word4 (Nodes.Table (N + 4).Field12).Flag215; - end Flag215; - - function Flag216 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).In_List; - end Flag216; - - function Flag217 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Has_Aspects; - end Flag217; - - function Flag218 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Rewrite_Ins; - end Flag218; - - function Flag219 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Analyzed; - end Flag219; - - function Flag220 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Comes_From_Source; - end Flag220; - - function Flag221 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Error_Posted; - end Flag221; - - function Flag222 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag4; - end Flag222; - - function Flag223 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag5; - end Flag223; - - function Flag224 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag6; - end Flag224; - - function Flag225 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag7; - end Flag225; - - function Flag226 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag8; - end Flag226; - - function Flag227 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag9; - end Flag227; - - function Flag228 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag10; - end Flag228; - - function Flag229 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag11; - end Flag229; - - function Flag230 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag12; - end Flag230; - - function Flag231 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag13; - end Flag231; - - function Flag232 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag14; - end Flag232; - - function Flag233 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag15; - end Flag233; - - function Flag234 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag16; - end Flag234; - - function Flag235 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag17; - end Flag235; - - function Flag236 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Flag18; - end Flag236; - - function Flag237 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Pflag1; - end Flag237; - - function Flag238 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Pflag2; - end Flag238; - - function Flag239 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag239; - end Flag239; - - function Flag240 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag240; - end Flag240; - - function Flag241 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag241; - end Flag241; - - function Flag242 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag242; - end Flag242; - - function Flag243 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag243; - end Flag243; - - function Flag244 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag244; - end Flag244; - - function Flag245 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag245; - end Flag245; - - function Flag246 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte2 (Nodes.Table (N + 3).Nkind).Flag246; - end Flag246; - - function Flag247 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag247; - end Flag247; - - function Flag248 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag248; - end Flag248; - - function Flag249 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag249; - end Flag249; - - function Flag250 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag250; - end Flag250; - - function Flag251 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag251; - end Flag251; - - function Flag252 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag252; - end Flag252; - - function Flag253 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag253; - end Flag253; - - function Flag254 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte3 (Nodes.Table (N + 4).Nkind).Flag254; - end Flag254; - - function Flag255 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag255; - end Flag255; - - function Flag256 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag256; - end Flag256; - - function Flag257 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag257; - end Flag257; - - function Flag258 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag258; - end Flag258; - - function Flag259 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag259; - end Flag259; - - function Flag260 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag260; - end Flag260; - - function Flag261 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag261; - end Flag261; - - function Flag262 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag262; - end Flag262; - - function Flag263 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag263; - end Flag263; - - function Flag264 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag264; - end Flag264; - - function Flag265 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag265; - end Flag265; - - function Flag266 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag266; - end Flag266; - - function Flag267 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag267; - end Flag267; - - function Flag268 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag268; - end Flag268; - - function Flag269 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag269; - end Flag269; - - function Flag270 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag270; - end Flag270; - - function Flag271 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag271; - end Flag271; - - function Flag272 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag272; - end Flag272; - - function Flag273 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag273; - end Flag273; - - function Flag274 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag274; - end Flag274; - - function Flag275 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag275; - end Flag275; - - function Flag276 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag276; - end Flag276; - - function Flag277 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag277; - end Flag277; - - function Flag278 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag278; - end Flag278; - - function Flag279 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag279; - end Flag279; - - function Flag280 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag280; - end Flag280; - - function Flag281 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag281; - end Flag281; - - function Flag282 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag282; - end Flag282; - - function Flag283 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag283; - end Flag283; - - function Flag284 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag284; - end Flag284; - - function Flag285 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag285; - end Flag285; - - function Flag286 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Word5 (Nodes.Table (N + 5).Field12).Flag286; - end Flag286; - - function Flag287 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).In_List; - end Flag287; - - function Flag288 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Has_Aspects; - end Flag288; - - function Flag289 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Rewrite_Ins; - end Flag289; - - function Flag290 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Analyzed; - end Flag290; - - function Flag291 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Comes_From_Source; - end Flag291; - - function Flag292 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Error_Posted; - end Flag292; - - function Flag293 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag4; - end Flag293; - - function Flag294 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag5; - end Flag294; - - function Flag295 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag6; - end Flag295; - - function Flag296 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag7; - end Flag296; - - function Flag297 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag8; - end Flag297; - - function Flag298 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag9; - end Flag298; - - function Flag299 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag10; - end Flag299; - - function Flag300 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag11; - end Flag300; - - function Flag301 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag12; - end Flag301; - - function Flag302 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag13; - end Flag302; - - function Flag303 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag14; - end Flag303; - - function Flag304 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag15; - end Flag304; - - function Flag305 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag16; - end Flag305; - - function Flag306 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag17; - end Flag306; - - function Flag307 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Flag18; - end Flag307; - - function Flag308 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Pflag1; - end Flag308; - - function Flag309 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 5).Pflag2; - end Flag309; - - function Flag310 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag310; - end Flag310; - - function Flag311 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag311; - end Flag311; - - function Flag312 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag312; - end Flag312; - - function Flag313 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag313; - end Flag313; - - function Flag314 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag314; - end Flag314; - - function Flag315 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag315; - end Flag315; - - function Flag316 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag316; - end Flag316; - - function Flag317 (N : Node_Id) return Boolean is - begin - pragma Assert (Nkind (N) in N_Entity); - return To_Flag_Byte4 (Nodes.Table (N + 5).Nkind).Flag317; - end Flag317; - - procedure Set_Nkind (N : Node_Id; Val : Node_Kind) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Nkind := Val; - end Set_Nkind; - - procedure Set_Field1 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field1 := Val; - end Set_Field1; - - procedure Set_Field2 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field2 := Val; - end Set_Field2; - - procedure Set_Field3 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field3 := Val; - end Set_Field3; - - procedure Set_Field4 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field4 := Val; - end Set_Field4; - - procedure Set_Field5 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field5 := Val; - end Set_Field5; - - procedure Set_Field6 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field6 := Val; - end Set_Field6; - - procedure Set_Field7 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field7 := Val; - end Set_Field7; - - procedure Set_Field8 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field8 := Val; - end Set_Field8; - - procedure Set_Field9 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field9 := Val; - end Set_Field9; - - procedure Set_Field10 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field10 := Val; - end Set_Field10; - - procedure Set_Field11 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field11 := Val; - end Set_Field11; - - procedure Set_Field12 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field12 := Val; - end Set_Field12; - - procedure Set_Field13 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field6 := Val; - end Set_Field13; - - procedure Set_Field14 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field7 := Val; - end Set_Field14; - - procedure Set_Field15 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field8 := Val; - end Set_Field15; - - procedure Set_Field16 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field9 := Val; - end Set_Field16; - - procedure Set_Field17 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field10 := Val; - end Set_Field17; - - procedure Set_Field18 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field11 := Val; - end Set_Field18; - - procedure Set_Field19 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field6 := Val; - end Set_Field19; - - procedure Set_Field20 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field7 := Val; - end Set_Field20; - - procedure Set_Field21 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field8 := Val; - end Set_Field21; - - procedure Set_Field22 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field9 := Val; - end Set_Field22; - - procedure Set_Field23 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field10 := Val; - end Set_Field23; - - procedure Set_Field24 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field6 := Val; - end Set_Field24; - - procedure Set_Field25 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field7 := Val; - end Set_Field25; - - procedure Set_Field26 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field8 := Val; - end Set_Field26; - - procedure Set_Field27 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field9 := Val; - end Set_Field27; - - procedure Set_Field28 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field10 := Val; - end Set_Field28; - - procedure Set_Field29 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field11 := Val; - end Set_Field29; - - procedure Set_Field30 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field6 := Val; - end Set_Field30; - - procedure Set_Field31 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field7 := Val; - end Set_Field31; - - procedure Set_Field32 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field8 := Val; - end Set_Field32; - - procedure Set_Field33 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field9 := Val; - end Set_Field33; - - procedure Set_Field34 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field10 := Val; - end Set_Field34; - - procedure Set_Field35 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field11 := Val; - end Set_Field35; - - procedure Set_Field36 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field6 := Val; - end Set_Field36; - - procedure Set_Field37 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field7 := Val; - end Set_Field37; - - procedure Set_Field38 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field8 := Val; - end Set_Field38; - - procedure Set_Field39 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field9 := Val; - end Set_Field39; - - procedure Set_Field40 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field10 := Val; - end Set_Field40; - - procedure Set_Field41 (N : Node_Id; Val : Union_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field11 := Val; - end Set_Field41; - - procedure Set_Node1 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field1 := Union_Id (Val); - end Set_Node1; - - procedure Set_Node2 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field2 := Union_Id (Val); - end Set_Node2; - - procedure Set_Node3 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field3 := Union_Id (Val); - end Set_Node3; - - procedure Set_Node4 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field4 := Union_Id (Val); - end Set_Node4; - - procedure Set_Node5 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field5 := Union_Id (Val); - end Set_Node5; - - procedure Set_Node6 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field6 := Union_Id (Val); - end Set_Node6; - - procedure Set_Node7 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field7 := Union_Id (Val); - end Set_Node7; - - procedure Set_Node8 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field8 := Union_Id (Val); - end Set_Node8; - - procedure Set_Node9 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field9 := Union_Id (Val); - end Set_Node9; - - procedure Set_Node10 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field10 := Union_Id (Val); - end Set_Node10; - - procedure Set_Node11 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field11 := Union_Id (Val); - end Set_Node11; - - procedure Set_Node12 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field12 := Union_Id (Val); - end Set_Node12; - - procedure Set_Node13 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field6 := Union_Id (Val); - end Set_Node13; - - procedure Set_Node14 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field7 := Union_Id (Val); - end Set_Node14; - - procedure Set_Node15 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field8 := Union_Id (Val); - end Set_Node15; - - procedure Set_Node16 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field9 := Union_Id (Val); - end Set_Node16; - - procedure Set_Node17 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field10 := Union_Id (Val); - end Set_Node17; - - procedure Set_Node18 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field11 := Union_Id (Val); - end Set_Node18; - - procedure Set_Node19 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field6 := Union_Id (Val); - end Set_Node19; - - procedure Set_Node20 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field7 := Union_Id (Val); - end Set_Node20; - - procedure Set_Node21 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field8 := Union_Id (Val); - end Set_Node21; - - procedure Set_Node22 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field9 := Union_Id (Val); - end Set_Node22; - - procedure Set_Node23 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field10 := Union_Id (Val); - end Set_Node23; - - procedure Set_Node24 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field6 := Union_Id (Val); - end Set_Node24; - - procedure Set_Node25 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field7 := Union_Id (Val); - end Set_Node25; - - procedure Set_Node26 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field8 := Union_Id (Val); - end Set_Node26; - - procedure Set_Node27 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field9 := Union_Id (Val); - end Set_Node27; - - procedure Set_Node28 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field10 := Union_Id (Val); - end Set_Node28; - - procedure Set_Node29 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field11 := Union_Id (Val); - end Set_Node29; - - procedure Set_Node30 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field6 := Union_Id (Val); - end Set_Node30; - - procedure Set_Node31 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field7 := Union_Id (Val); - end Set_Node31; - - procedure Set_Node32 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field8 := Union_Id (Val); - end Set_Node32; - - procedure Set_Node33 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field9 := Union_Id (Val); - end Set_Node33; - - procedure Set_Node34 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field10 := Union_Id (Val); - end Set_Node34; - - procedure Set_Node35 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field11 := Union_Id (Val); - end Set_Node35; - - procedure Set_Node36 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field6 := Union_Id (Val); - end Set_Node36; - - procedure Set_Node37 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field7 := Union_Id (Val); - end Set_Node37; - - procedure Set_Node38 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field8 := Union_Id (Val); - end Set_Node38; - - procedure Set_Node39 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field9 := Union_Id (Val); - end Set_Node39; - - procedure Set_Node40 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field10 := Union_Id (Val); - end Set_Node40; - - procedure Set_Node41 (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field11 := Union_Id (Val); - end Set_Node41; - - procedure Set_List1 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field1 := Union_Id (Val); - end Set_List1; - - procedure Set_List2 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field2 := Union_Id (Val); - end Set_List2; - - procedure Set_List3 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field3 := Union_Id (Val); - end Set_List3; - - procedure Set_List4 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field4 := Union_Id (Val); - end Set_List4; - - procedure Set_List5 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field5 := Union_Id (Val); - end Set_List5; - - procedure Set_List10 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field10 := Union_Id (Val); - end Set_List10; - - procedure Set_List14 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field7 := Union_Id (Val); - end Set_List14; - - procedure Set_List25 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field7 := Union_Id (Val); - end Set_List25; - - procedure Set_List38 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field8 := Union_Id (Val); - end Set_List38; - - procedure Set_List39 (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field9 := Union_Id (Val); - end Set_List39; - - procedure Set_Elist1 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Field1 := Union_Id (Val); - end Set_Elist1; - - procedure Set_Elist2 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Field2 := Union_Id (Val); - end Set_Elist2; - - procedure Set_Elist3 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Field3 := Union_Id (Val); - end Set_Elist3; - - procedure Set_Elist4 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Field4 := Union_Id (Val); - end Set_Elist4; - - procedure Set_Elist5 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - Nodes.Table (N).Field5 := Union_Id (Val); - end Set_Elist5; - - procedure Set_Elist8 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field8 := Union_Id (Val); - end Set_Elist8; - - procedure Set_Elist9 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field9 := Union_Id (Val); - end Set_Elist9; - - procedure Set_Elist10 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field10 := Union_Id (Val); - end Set_Elist10; - - procedure Set_Elist11 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field11 := Union_Id (Val); - end Set_Elist11; - - procedure Set_Elist13 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field6 := Union_Id (Val); - end Set_Elist13; - - procedure Set_Elist15 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field8 := Union_Id (Val); - end Set_Elist15; - - procedure Set_Elist16 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field9 := Union_Id (Val); - end Set_Elist16; - - procedure Set_Elist18 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field11 := Union_Id (Val); - end Set_Elist18; - - procedure Set_Elist21 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field8 := Union_Id (Val); - end Set_Elist21; - - procedure Set_Elist23 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field10 := Union_Id (Val); - end Set_Elist23; - - procedure Set_Elist24 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field6 := Union_Id (Val); - end Set_Elist24; - - procedure Set_Elist25 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field7 := Union_Id (Val); - end Set_Elist25; - - procedure Set_Elist26 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field8 := Union_Id (Val); - end Set_Elist26; - - procedure Set_Elist29 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field11 := Union_Id (Val); - end Set_Elist29; - - procedure Set_Elist30 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Field6 := Union_Id (Val); - end Set_Elist30; - - procedure Set_Elist36 (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 6).Field6 := Union_Id (Val); - end Set_Elist36; - - procedure Set_Name1 (N : Node_Id; Val : Name_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field1 := Union_Id (Val); - end Set_Name1; - - procedure Set_Name2 (N : Node_Id; Val : Name_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field2 := Union_Id (Val); - end Set_Name2; - - procedure Set_Str3 (N : Node_Id; Val : String_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field3 := Union_Id (Val); - end Set_Str3; - - procedure Set_Uint2 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field2 := To_Union (Val); - end Set_Uint2; - - procedure Set_Uint3 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field3 := To_Union (Val); - end Set_Uint3; - - procedure Set_Uint4 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field4 := To_Union (Val); - end Set_Uint4; - - procedure Set_Uint5 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field5 := To_Union (Val); - end Set_Uint5; - - procedure Set_Uint8 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field8 := To_Union (Val); - end Set_Uint8; - - procedure Set_Uint9 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field9 := To_Union (Val); - end Set_Uint9; - - procedure Set_Uint10 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field10 := To_Union (Val); - end Set_Uint10; - - procedure Set_Uint11 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field11 := To_Union (Val); - end Set_Uint11; - - procedure Set_Uint12 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Field12 := To_Union (Val); - end Set_Uint12; - - procedure Set_Uint13 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field6 := To_Union (Val); - end Set_Uint13; - - procedure Set_Uint14 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field7 := To_Union (Val); - end Set_Uint14; - - procedure Set_Uint15 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field8 := To_Union (Val); - end Set_Uint15; - - procedure Set_Uint16 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field9 := To_Union (Val); - end Set_Uint16; - - procedure Set_Uint17 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field10 := To_Union (Val); - end Set_Uint17; - - procedure Set_Uint22 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field9 := To_Union (Val); - end Set_Uint22; - - procedure Set_Uint24 (N : Node_Id; Val : Uint) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Field6 := To_Union (Val); - end Set_Uint24; - - procedure Set_Ureal3 (N : Node_Id; Val : Ureal) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Field3 := To_Union (Val); - end Set_Ureal3; - - procedure Set_Ureal18 (N : Node_Id; Val : Ureal) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Field11 := To_Union (Val); - end Set_Ureal18; - - procedure Set_Ureal21 (N : Node_Id; Val : Ureal) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Field8 := To_Union (Val); - end Set_Ureal21; - - procedure Set_Flag0 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Flags.Table (N).Flag0 := Val; - end Set_Flag0; - - procedure Set_Flag1 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Flags.Table (N).Flag1 := Val; - end Set_Flag1; - - procedure Set_Flag2 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Flags.Table (N).Flag2 := Val; - end Set_Flag2; - - procedure Set_Flag3 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Flags.Table (N).Flag3 := Val; - end Set_Flag3; - - procedure Set_Flag4 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag4 := Val; - end Set_Flag4; - - procedure Set_Flag5 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag5 := Val; - end Set_Flag5; - - procedure Set_Flag6 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag6 := Val; - end Set_Flag6; - - procedure Set_Flag7 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag7 := Val; - end Set_Flag7; - - procedure Set_Flag8 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag8 := Val; - end Set_Flag8; - - procedure Set_Flag9 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag9 := Val; - end Set_Flag9; - - procedure Set_Flag10 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag10 := Val; - end Set_Flag10; - - procedure Set_Flag11 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag11 := Val; - end Set_Flag11; - - procedure Set_Flag12 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag12 := Val; - end Set_Flag12; - - procedure Set_Flag13 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag13 := Val; - end Set_Flag13; - - procedure Set_Flag14 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag14 := Val; - end Set_Flag14; - - procedure Set_Flag15 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag15 := Val; - end Set_Flag15; - - procedure Set_Flag16 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag16 := Val; - end Set_Flag16; - - procedure Set_Flag17 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag17 := Val; - end Set_Flag17; - - procedure Set_Flag18 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - Nodes.Table (N).Flag18 := Val; - end Set_Flag18; - - procedure Set_Flag19 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).In_List := Val; - end Set_Flag19; - - procedure Set_Flag20 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Has_Aspects := Val; - end Set_Flag20; - - procedure Set_Flag21 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Rewrite_Ins := Val; - end Set_Flag21; - - procedure Set_Flag22 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Analyzed := Val; - end Set_Flag22; - - procedure Set_Flag23 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Comes_From_Source := Val; - end Set_Flag23; - - procedure Set_Flag24 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Error_Posted := Val; - end Set_Flag24; - - procedure Set_Flag25 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag4 := Val; - end Set_Flag25; - - procedure Set_Flag26 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag5 := Val; - end Set_Flag26; - - procedure Set_Flag27 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag6 := Val; - end Set_Flag27; - - procedure Set_Flag28 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag7 := Val; - end Set_Flag28; - - procedure Set_Flag29 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag8 := Val; - end Set_Flag29; - - procedure Set_Flag30 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag9 := Val; - end Set_Flag30; - - procedure Set_Flag31 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag10 := Val; - end Set_Flag31; - - procedure Set_Flag32 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag11 := Val; - end Set_Flag32; - - procedure Set_Flag33 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag12 := Val; - end Set_Flag33; - - procedure Set_Flag34 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag13 := Val; - end Set_Flag34; - - procedure Set_Flag35 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag14 := Val; - end Set_Flag35; - - procedure Set_Flag36 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag15 := Val; - end Set_Flag36; - - procedure Set_Flag37 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag16 := Val; - end Set_Flag37; - - procedure Set_Flag38 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag17 := Val; - end Set_Flag38; - - procedure Set_Flag39 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Flag18 := Val; - end Set_Flag39; - - procedure Set_Flag40 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).In_List := Val; - end Set_Flag40; - - procedure Set_Flag41 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Has_Aspects := Val; - end Set_Flag41; - - procedure Set_Flag42 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Rewrite_Ins := Val; - end Set_Flag42; - - procedure Set_Flag43 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Analyzed := Val; - end Set_Flag43; - - procedure Set_Flag44 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Comes_From_Source := Val; - end Set_Flag44; - - procedure Set_Flag45 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Error_Posted := Val; - end Set_Flag45; - - procedure Set_Flag46 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag4 := Val; - end Set_Flag46; - - procedure Set_Flag47 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag5 := Val; - end Set_Flag47; - - procedure Set_Flag48 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag6 := Val; - end Set_Flag48; - - procedure Set_Flag49 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag7 := Val; - end Set_Flag49; - - procedure Set_Flag50 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag8 := Val; - end Set_Flag50; - - procedure Set_Flag51 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag9 := Val; - end Set_Flag51; - - procedure Set_Flag52 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag10 := Val; - end Set_Flag52; - - procedure Set_Flag53 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag11 := Val; - end Set_Flag53; - - procedure Set_Flag54 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag12 := Val; - end Set_Flag54; - - procedure Set_Flag55 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag13 := Val; - end Set_Flag55; - - procedure Set_Flag56 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag14 := Val; - end Set_Flag56; - - procedure Set_Flag57 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag15 := Val; - end Set_Flag57; - - procedure Set_Flag58 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag16 := Val; - end Set_Flag58; - - procedure Set_Flag59 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag17 := Val; - end Set_Flag59; - - procedure Set_Flag60 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Flag18 := Val; - end Set_Flag60; - - procedure Set_Flag61 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Pflag1 := Val; - end Set_Flag61; - - procedure Set_Flag62 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Pflag2 := Val; - end Set_Flag62; - - procedure Set_Flag63 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Pflag1 := Val; - end Set_Flag63; - - procedure Set_Flag64 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Pflag2 := Val; - end Set_Flag64; - - procedure Set_Flag65 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag65 := Val; - end Set_Flag65; - - procedure Set_Flag66 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag66 := Val; - end Set_Flag66; - - procedure Set_Flag67 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag67 := Val; - end Set_Flag67; - - procedure Set_Flag68 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag68 := Val; - end Set_Flag68; - - procedure Set_Flag69 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag69 := Val; - end Set_Flag69; - - procedure Set_Flag70 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag70 := Val; - end Set_Flag70; - - procedure Set_Flag71 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag71 := Val; - end Set_Flag71; - - procedure Set_Flag72 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 2).Nkind'Unrestricted_Access)).Flag72 := Val; - end Set_Flag72; - - procedure Set_Flag73 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag73 := Val; - end Set_Flag73; - - procedure Set_Flag74 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag74 := Val; - end Set_Flag74; - - procedure Set_Flag75 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag75 := Val; - end Set_Flag75; - - procedure Set_Flag76 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag76 := Val; - end Set_Flag76; - - procedure Set_Flag77 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag77 := Val; - end Set_Flag77; - - procedure Set_Flag78 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag78 := Val; - end Set_Flag78; - - procedure Set_Flag79 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag79 := Val; - end Set_Flag79; - - procedure Set_Flag80 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag80 := Val; - end Set_Flag80; - - procedure Set_Flag81 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag81 := Val; - end Set_Flag81; - - procedure Set_Flag82 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag82 := Val; - end Set_Flag82; - - procedure Set_Flag83 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag83 := Val; - end Set_Flag83; - - procedure Set_Flag84 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag84 := Val; - end Set_Flag84; - - procedure Set_Flag85 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag85 := Val; - end Set_Flag85; - - procedure Set_Flag86 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag86 := Val; - end Set_Flag86; - - procedure Set_Flag87 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag87 := Val; - end Set_Flag87; - - procedure Set_Flag88 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag88 := Val; - end Set_Flag88; - - procedure Set_Flag89 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag89 := Val; - end Set_Flag89; - - procedure Set_Flag90 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag90 := Val; - end Set_Flag90; - - procedure Set_Flag91 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag91 := Val; - end Set_Flag91; - - procedure Set_Flag92 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag92 := Val; - end Set_Flag92; - - procedure Set_Flag93 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag93 := Val; - end Set_Flag93; - - procedure Set_Flag94 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag94 := Val; - end Set_Flag94; - - procedure Set_Flag95 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag95 := Val; - end Set_Flag95; - - procedure Set_Flag96 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 2).Field12'Unrestricted_Access)).Flag96 := Val; - end Set_Flag96; - - procedure Set_Flag97 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag97 := Val; - end Set_Flag97; - - procedure Set_Flag98 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag98 := Val; - end Set_Flag98; - - procedure Set_Flag99 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag99 := Val; - end Set_Flag99; - - procedure Set_Flag100 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag100 := Val; - end Set_Flag100; - - procedure Set_Flag101 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag101 := Val; - end Set_Flag101; - - procedure Set_Flag102 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag102 := Val; - end Set_Flag102; - - procedure Set_Flag103 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag103 := Val; - end Set_Flag103; - - procedure Set_Flag104 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag104 := Val; - end Set_Flag104; - - procedure Set_Flag105 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag105 := Val; - end Set_Flag105; - - procedure Set_Flag106 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag106 := Val; - end Set_Flag106; - - procedure Set_Flag107 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag107 := Val; - end Set_Flag107; - - procedure Set_Flag108 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag108 := Val; - end Set_Flag108; - - procedure Set_Flag109 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag109 := Val; - end Set_Flag109; - - procedure Set_Flag110 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag110 := Val; - end Set_Flag110; - - procedure Set_Flag111 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag111 := Val; - end Set_Flag111; - - procedure Set_Flag112 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag112 := Val; - end Set_Flag112; - - procedure Set_Flag113 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag113 := Val; - end Set_Flag113; - - procedure Set_Flag114 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag114 := Val; - end Set_Flag114; - - procedure Set_Flag115 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag115 := Val; - end Set_Flag115; - - procedure Set_Flag116 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag116 := Val; - end Set_Flag116; - - procedure Set_Flag117 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag117 := Val; - end Set_Flag117; - - procedure Set_Flag118 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag118 := Val; - end Set_Flag118; - - procedure Set_Flag119 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag119 := Val; - end Set_Flag119; - - procedure Set_Flag120 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag120 := Val; - end Set_Flag120; - - procedure Set_Flag121 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag121 := Val; - end Set_Flag121; - - procedure Set_Flag122 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag122 := Val; - end Set_Flag122; - - procedure Set_Flag123 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag123 := Val; - end Set_Flag123; - - procedure Set_Flag124 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag124 := Val; - end Set_Flag124; - - procedure Set_Flag125 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag125 := Val; - end Set_Flag125; - - procedure Set_Flag126 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag126 := Val; - end Set_Flag126; - - procedure Set_Flag127 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag127 := Val; - end Set_Flag127; - - procedure Set_Flag128 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word2_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field12'Unrestricted_Access)).Flag128 := Val; - end Set_Flag128; - - procedure Set_Flag129 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).In_List := Val; - end Set_Flag129; - - procedure Set_Flag130 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Has_Aspects := Val; - end Set_Flag130; - - procedure Set_Flag131 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Rewrite_Ins := Val; - end Set_Flag131; - - procedure Set_Flag132 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Analyzed := Val; - end Set_Flag132; - - procedure Set_Flag133 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Comes_From_Source := Val; - end Set_Flag133; - - procedure Set_Flag134 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Error_Posted := Val; - end Set_Flag134; - - procedure Set_Flag135 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag4 := Val; - end Set_Flag135; - - procedure Set_Flag136 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag5 := Val; - end Set_Flag136; - - procedure Set_Flag137 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag6 := Val; - end Set_Flag137; - - procedure Set_Flag138 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag7 := Val; - end Set_Flag138; - - procedure Set_Flag139 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag8 := Val; - end Set_Flag139; - - procedure Set_Flag140 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag9 := Val; - end Set_Flag140; - - procedure Set_Flag141 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag10 := Val; - end Set_Flag141; - - procedure Set_Flag142 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag11 := Val; - end Set_Flag142; - - procedure Set_Flag143 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag12 := Val; - end Set_Flag143; - - procedure Set_Flag144 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag13 := Val; - end Set_Flag144; - - procedure Set_Flag145 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag14 := Val; - end Set_Flag145; - - procedure Set_Flag146 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag15 := Val; - end Set_Flag146; - - procedure Set_Flag147 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag16 := Val; - end Set_Flag147; - - procedure Set_Flag148 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag17 := Val; - end Set_Flag148; - - procedure Set_Flag149 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Flag18 := Val; - end Set_Flag149; - - procedure Set_Flag150 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Pflag1 := Val; - end Set_Flag150; - - procedure Set_Flag151 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Pflag2 := Val; - end Set_Flag151; - - procedure Set_Flag152 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag152 := Val; - end Set_Flag152; - - procedure Set_Flag153 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag153 := Val; - end Set_Flag153; - - procedure Set_Flag154 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag154 := Val; - end Set_Flag154; - - procedure Set_Flag155 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag155 := Val; - end Set_Flag155; - - procedure Set_Flag156 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag156 := Val; - end Set_Flag156; - - procedure Set_Flag157 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag157 := Val; - end Set_Flag157; - - procedure Set_Flag158 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag158 := Val; - end Set_Flag158; - - procedure Set_Flag159 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag159 := Val; - end Set_Flag159; - - procedure Set_Flag160 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag160 := Val; - end Set_Flag160; - - procedure Set_Flag161 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag161 := Val; - end Set_Flag161; - - procedure Set_Flag162 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag162 := Val; - end Set_Flag162; - - procedure Set_Flag163 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag163 := Val; - end Set_Flag163; - - procedure Set_Flag164 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag164 := Val; - end Set_Flag164; - - procedure Set_Flag165 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag165 := Val; - end Set_Flag165; - - procedure Set_Flag166 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag166 := Val; - end Set_Flag166; - - procedure Set_Flag167 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag167 := Val; - end Set_Flag167; - - procedure Set_Flag168 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag168 := Val; - end Set_Flag168; - - procedure Set_Flag169 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag169 := Val; - end Set_Flag169; - - procedure Set_Flag170 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag170 := Val; - end Set_Flag170; - - procedure Set_Flag171 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag171 := Val; - end Set_Flag171; - - procedure Set_Flag172 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag172 := Val; - end Set_Flag172; - - procedure Set_Flag173 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag173 := Val; - end Set_Flag173; - - procedure Set_Flag174 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag174 := Val; - end Set_Flag174; - - procedure Set_Flag175 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag175 := Val; - end Set_Flag175; - - procedure Set_Flag176 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag176 := Val; - end Set_Flag176; - - procedure Set_Flag177 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag177 := Val; - end Set_Flag177; - - procedure Set_Flag178 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag178 := Val; - end Set_Flag178; - - procedure Set_Flag179 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag179 := Val; - end Set_Flag179; - - procedure Set_Flag180 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag180 := Val; - end Set_Flag180; - - procedure Set_Flag181 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag181 := Val; - end Set_Flag181; - - procedure Set_Flag182 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag182 := Val; - end Set_Flag182; - - procedure Set_Flag183 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word3_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 3).Field11'Unrestricted_Access)).Flag183 := Val; - end Set_Flag183; - - procedure Set_Flag184 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag184 := Val; - end Set_Flag184; - - procedure Set_Flag185 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag185 := Val; - end Set_Flag185; - - procedure Set_Flag186 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag186 := Val; - end Set_Flag186; - - procedure Set_Flag187 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag187 := Val; - end Set_Flag187; - - procedure Set_Flag188 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag188 := Val; - end Set_Flag188; - - procedure Set_Flag189 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag189 := Val; - end Set_Flag189; - - procedure Set_Flag190 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag190 := Val; - end Set_Flag190; - - procedure Set_Flag191 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag191 := Val; - end Set_Flag191; - - procedure Set_Flag192 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag192 := Val; - end Set_Flag192; - - procedure Set_Flag193 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag193 := Val; - end Set_Flag193; - - procedure Set_Flag194 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag194 := Val; - end Set_Flag194; - - procedure Set_Flag195 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag195 := Val; - end Set_Flag195; - - procedure Set_Flag196 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag196 := Val; - end Set_Flag196; - - procedure Set_Flag197 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag197 := Val; - end Set_Flag197; - - procedure Set_Flag198 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag198 := Val; - end Set_Flag198; - - procedure Set_Flag199 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag199 := Val; - end Set_Flag199; - - procedure Set_Flag200 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag200 := Val; - end Set_Flag200; - - procedure Set_Flag201 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag201 := Val; - end Set_Flag201; - - procedure Set_Flag202 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag202 := Val; - end Set_Flag202; - - procedure Set_Flag203 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag203 := Val; - end Set_Flag203; - - procedure Set_Flag204 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag204 := Val; - end Set_Flag204; - - procedure Set_Flag205 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag205 := Val; - end Set_Flag205; - - procedure Set_Flag206 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag206 := Val; - end Set_Flag206; - - procedure Set_Flag207 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag207 := Val; - end Set_Flag207; - - procedure Set_Flag208 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag208 := Val; - end Set_Flag208; - - procedure Set_Flag209 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag209 := Val; - end Set_Flag209; - - procedure Set_Flag210 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag210 := Val; - end Set_Flag210; - - procedure Set_Flag211 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag211 := Val; - end Set_Flag211; - - procedure Set_Flag212 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag212 := Val; - end Set_Flag212; - - procedure Set_Flag213 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag213 := Val; - end Set_Flag213; - - procedure Set_Flag214 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag214 := Val; - end Set_Flag214; - - procedure Set_Flag215 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word4_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag215 := Val; - end Set_Flag215; - - procedure Set_Flag216 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).In_List := Val; - end Set_Flag216; - - procedure Set_Flag217 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Has_Aspects := Val; - end Set_Flag217; - - procedure Set_Flag218 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Rewrite_Ins := Val; - end Set_Flag218; - - procedure Set_Flag219 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Analyzed := Val; - end Set_Flag219; - - procedure Set_Flag220 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Comes_From_Source := Val; - end Set_Flag220; - - procedure Set_Flag221 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Error_Posted := Val; - end Set_Flag221; - - procedure Set_Flag222 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag4 := Val; - end Set_Flag222; - - procedure Set_Flag223 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag5 := Val; - end Set_Flag223; - - procedure Set_Flag224 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag6 := Val; - end Set_Flag224; - - procedure Set_Flag225 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag7 := Val; - end Set_Flag225; - - procedure Set_Flag226 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag8 := Val; - end Set_Flag226; - - procedure Set_Flag227 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag9 := Val; - end Set_Flag227; - - procedure Set_Flag228 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag10 := Val; - end Set_Flag228; - - procedure Set_Flag229 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag11 := Val; - end Set_Flag229; - - procedure Set_Flag230 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag12 := Val; - end Set_Flag230; - - procedure Set_Flag231 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag13 := Val; - end Set_Flag231; - - procedure Set_Flag232 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag14 := Val; - end Set_Flag232; - - procedure Set_Flag233 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag15 := Val; - end Set_Flag233; - - procedure Set_Flag234 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag16 := Val; - end Set_Flag234; - - procedure Set_Flag235 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag17 := Val; - end Set_Flag235; - - procedure Set_Flag236 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Flag18 := Val; - end Set_Flag236; - - procedure Set_Flag237 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Pflag1 := Val; - end Set_Flag237; - - procedure Set_Flag238 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Pflag2 := Val; - end Set_Flag238; - - procedure Set_Flag239 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag239 := Val; - end Set_Flag239; - - procedure Set_Flag240 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag240 := Val; - end Set_Flag240; - - procedure Set_Flag241 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag241 := Val; - end Set_Flag241; - - procedure Set_Flag242 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag242 := Val; - end Set_Flag242; - - procedure Set_Flag243 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag243 := Val; - end Set_Flag243; - - procedure Set_Flag244 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag244 := Val; - end Set_Flag244; - - procedure Set_Flag245 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag245 := Val; - end Set_Flag245; - - procedure Set_Flag246 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte2_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 3).Nkind'Unrestricted_Access)).Flag246 := Val; - end Set_Flag246; - - procedure Set_Flag247 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag247 := Val; - end Set_Flag247; - - procedure Set_Flag248 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag248 := Val; - end Set_Flag248; - - procedure Set_Flag249 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag249 := Val; - end Set_Flag249; - - procedure Set_Flag250 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag250 := Val; - end Set_Flag250; - - procedure Set_Flag251 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag251 := Val; - end Set_Flag251; - - procedure Set_Flag252 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag252 := Val; - end Set_Flag252; - - procedure Set_Flag253 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag253 := Val; - end Set_Flag253; - - procedure Set_Flag254 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte3_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 4).Nkind'Unrestricted_Access)).Flag254 := Val; - end Set_Flag254; - - procedure Set_Flag255 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag255 := Val; - end Set_Flag255; - - procedure Set_Flag256 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag256 := Val; - end Set_Flag256; - - procedure Set_Flag257 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag257 := Val; - end Set_Flag257; - - procedure Set_Flag258 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag258 := Val; - end Set_Flag258; - - procedure Set_Flag259 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag259 := Val; - end Set_Flag259; - - procedure Set_Flag260 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag260 := Val; - end Set_Flag260; - - procedure Set_Flag261 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag261 := Val; - end Set_Flag261; - - procedure Set_Flag262 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag262 := Val; - end Set_Flag262; - - procedure Set_Flag263 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag263 := Val; - end Set_Flag263; - - procedure Set_Flag264 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag264 := Val; - end Set_Flag264; - - procedure Set_Flag265 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag265 := Val; - end Set_Flag265; - - procedure Set_Flag266 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag266 := Val; - end Set_Flag266; - - procedure Set_Flag267 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag267 := Val; - end Set_Flag267; - - procedure Set_Flag268 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag268 := Val; - end Set_Flag268; - - procedure Set_Flag269 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag269 := Val; - end Set_Flag269; - - procedure Set_Flag270 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag270 := Val; - end Set_Flag270; - - procedure Set_Flag271 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag271 := Val; - end Set_Flag271; - - procedure Set_Flag272 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag272 := Val; - end Set_Flag272; - - procedure Set_Flag273 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag273 := Val; - end Set_Flag273; - - procedure Set_Flag274 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag274 := Val; - end Set_Flag274; - - procedure Set_Flag275 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag275 := Val; - end Set_Flag275; - - procedure Set_Flag276 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag276 := Val; - end Set_Flag276; - - procedure Set_Flag277 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag277 := Val; - end Set_Flag277; - - procedure Set_Flag278 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag278 := Val; - end Set_Flag278; - - procedure Set_Flag279 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag279 := Val; - end Set_Flag279; - - procedure Set_Flag280 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag280 := Val; - end Set_Flag280; - - procedure Set_Flag281 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag281 := Val; - end Set_Flag281; - - procedure Set_Flag282 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag282 := Val; - end Set_Flag282; - - procedure Set_Flag283 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag283 := Val; - end Set_Flag283; - - procedure Set_Flag284 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag284 := Val; - end Set_Flag284; - - procedure Set_Flag285 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag285 := Val; - end Set_Flag285; - - procedure Set_Flag286 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Word5_Ptr - (Union_Id_Ptr' - (Nodes.Table (N + 5).Field12'Unrestricted_Access)).Flag286 := Val; - end Set_Flag286; - - procedure Set_Flag287 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).In_List := Val; - end Set_Flag287; - - procedure Set_Flag288 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Has_Aspects := Val; - end Set_Flag288; - - procedure Set_Flag289 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Rewrite_Ins := Val; - end Set_Flag289; - - procedure Set_Flag290 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Analyzed := Val; - end Set_Flag290; - - procedure Set_Flag291 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Comes_From_Source := Val; - end Set_Flag291; - - procedure Set_Flag292 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Error_Posted := Val; - end Set_Flag292; - - procedure Set_Flag293 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag4 := Val; - end Set_Flag293; - - procedure Set_Flag294 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag5 := Val; - end Set_Flag294; - - procedure Set_Flag295 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag6 := Val; - end Set_Flag295; - - procedure Set_Flag296 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag7 := Val; - end Set_Flag296; - - procedure Set_Flag297 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag8 := Val; - end Set_Flag297; - - procedure Set_Flag298 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag9 := Val; - end Set_Flag298; - - procedure Set_Flag299 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag10 := Val; - end Set_Flag299; - - procedure Set_Flag300 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag11 := Val; - end Set_Flag300; - - procedure Set_Flag301 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag12 := Val; - end Set_Flag301; - - procedure Set_Flag302 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag13 := Val; - end Set_Flag302; - - procedure Set_Flag303 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag14 := Val; - end Set_Flag303; - - procedure Set_Flag304 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag15 := Val; - end Set_Flag304; - - procedure Set_Flag305 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag16 := Val; - end Set_Flag305; - - procedure Set_Flag306 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag17 := Val; - end Set_Flag306; - - procedure Set_Flag307 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Flag18 := Val; - end Set_Flag307; - - procedure Set_Flag308 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Pflag1 := Val; - end Set_Flag308; - - procedure Set_Flag309 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 5).Pflag2 := Val; - end Set_Flag309; - - procedure Set_Flag310 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag310 := Val; - end Set_Flag310; - - procedure Set_Flag311 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag311 := Val; - end Set_Flag311; - - procedure Set_Flag312 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag312 := Val; - end Set_Flag312; - - procedure Set_Flag313 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag313 := Val; - end Set_Flag313; - - procedure Set_Flag314 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag314 := Val; - end Set_Flag314; - - procedure Set_Flag315 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag315 := Val; - end Set_Flag315; - - procedure Set_Flag316 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag316 := Val; - end Set_Flag316; - - procedure Set_Flag317 (N : Node_Id; Val : Boolean) is - begin - pragma Assert (not Locked); - pragma Assert (Nkind (N) in N_Entity); - To_Flag_Byte4_Ptr - (Node_Kind_Ptr' - (Nodes.Table (N + 5).Nkind'Unrestricted_Access)).Flag317 := Val; - end Set_Flag317; - - procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - - if Val > Error then - Set_Parent (N => Val, Val => N); - end if; - - Set_Node1 (N, Val); - end Set_Node1_With_Parent; - - procedure Set_Node2_With_Parent (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - - if Val > Error then - Set_Parent (N => Val, Val => N); - end if; - - Set_Node2 (N, Val); - end Set_Node2_With_Parent; - - procedure Set_Node3_With_Parent (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - - if Val > Error then - Set_Parent (N => Val, Val => N); - end if; - - Set_Node3 (N, Val); - end Set_Node3_With_Parent; - - procedure Set_Node4_With_Parent (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - - if Val > Error then - Set_Parent (N => Val, Val => N); - end if; - - Set_Node4 (N, Val); - end Set_Node4_With_Parent; - - procedure Set_Node5_With_Parent (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - - if Val > Error then - Set_Parent (N => Val, Val => N); - end if; - - Set_Node5 (N, Val); - end Set_Node5_With_Parent; - - procedure Set_List1_With_Parent (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - if Val /= No_List and then Val /= Error_List then - Set_Parent (Val, N); - end if; - Set_List1 (N, Val); - end Set_List1_With_Parent; - - procedure Set_List2_With_Parent (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - if Val /= No_List and then Val /= Error_List then - Set_Parent (Val, N); - end if; - Set_List2 (N, Val); - end Set_List2_With_Parent; - - procedure Set_List3_With_Parent (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - if Val /= No_List and then Val /= Error_List then - Set_Parent (Val, N); - end if; - Set_List3 (N, Val); - end Set_List3_With_Parent; - - procedure Set_List4_With_Parent (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - if Val /= No_List and then Val /= Error_List then - Set_Parent (Val, N); - end if; - Set_List4 (N, Val); - end Set_List4_With_Parent; - - procedure Set_List5_With_Parent (N : Node_Id; Val : List_Id) is - begin - pragma Assert (not Locked); - pragma Assert (N <= Nodes.Last); - if Val /= No_List and then Val /= Error_List then - Set_Parent (Val, N); - end if; - Set_List5 (N, Val); - end Set_List5_With_Parent; - - end Unchecked_Access; - ------------ -- Unlock -- ------------ procedure Unlock is begin - Flags.Locked := False; Orig_Nodes.Locked := False; end Unlock; @@ -8794,4 +2507,19 @@ package body Atree is Locked := False; end Unlock_Nodes; + Zero : constant Slot := (Field_Size => 32, Slot_32 => 0); + + procedure Zero_Slots (F, L : Node_Offset) is + begin + Slots.Table (F .. L) := (others => Zero); + -- Note that Zero.Field_Size is not stored, because Slot is an + -- Unchecked_Union. Hopefully, the compiler can generate efficient code + -- for this. + end Zero_Slots; + + procedure Zero_Slots (N : Node_Or_Entity_Id) is + begin + Zero_Slots (Off_0 (N), Off_L (N)); + end Zero_Slots; + end Atree; diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index c3ad899989e..473ae9767aa 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -24,63 +24,40 @@ ------------------------------------------------------------------------------ with Alloc; -with Sinfo; use Sinfo; -with Einfo; use Einfo; -with Namet; use Namet; +with Sinfo.Nodes; use Sinfo.Nodes; +with Einfo.Entities; use Einfo.Entities; with Types; use Types; -with Snames; use Snames; with System; use System; with Table; -with Uintp; use Uintp; -with Urealp; use Urealp; with Unchecked_Conversion; package Atree is --- This package defines the format of the tree used to represent the Ada --- program internally. Syntactic and semantic information is combined in --- this tree. There is no separate symbol table structure. +-- This package defines the low-level representation of the tree used to +-- represent the Ada program internally. Syntactic and semantic information +-- is combined in this tree. There is no separate symbol table structure. --- WARNING: There is a C version of this package. Any changes to this source --- file must be properly reflected in the C header file atree.h +-- WARNING: There is a C++ version of this package. Any changes to this source +-- file must be properly reflected in the C++ header file atree.h. -- Package Atree defines the basic structure of the tree and its nodes and -- provides the basic abstract interface for manipulating the tree. Two other -- packages use this interface to define the representation of Ada programs -- using this tree format. The package Sinfo defines the basic representation -- of the syntactic structure of the program, as output by the parser. The --- package Einfo defines the semantic information which is added to the tree --- nodes that represent declared entities (i.e. the information which might --- typically be described in a separate symbol table structure). +-- package Einfo defines the semantic information that is added to the tree +-- nodes that represent declared entities (i.e. the information that is +-- described in a separate symbol table structure in some other compilers). -- The front end of the compiler first parses the program and generates a -- tree that is simply a syntactic representation of the program in abstract -- syntax tree format. Subsequent processing in the front end traverses the -- tree, transforming it in various ways and adding semantic information. - ---------------------- - -- Size of Entities -- - ---------------------- - - -- Currently entities are composed of 7 sequentially allocated 32-byte - -- nodes, considered as a single record. The following definition gives - -- the number of extension nodes. ????We plan to change this. - - Num_Extension_Nodes : Node_Id := 6; - -- This value is increased by one if debug flag -gnatd.N is set. This is - -- for testing performance impact of adding a new extension node. We make - -- this of type Node_Id for easy reference in loops using this value. - -- Print_Statistics can be used to display statistics on entities & nodes. - -- Measurements conducted for the 5->6 bump showed an increase from 1.81 to - -- 2.01 for the nodes/entities ratio and a 2% increase in compilation time - -- on average for the GCC-based compiler at -O0 on a 32-bit x86 host. - - procedure Print_Statistics; - pragma Export (Ada, Print_Statistics); - -- Print various statistics on the tables maintained by the package + -- ????The following comments should be moved elsewhere. ---------------------------------------- - -- Definitions of Fields in Tree Node -- + -- Definitions of fields in tree node -- ---------------------------------------- -- The representation of the tree is completely hidden, using a functional @@ -97,7 +74,7 @@ package Atree is -- show which token is referenced by this pointer. -- In_List A flag used to indicate if the node is a member - -- of a node list. + -- of a node list (see package Nlists). -- Rewrite_Ins A flag set if a node is marked as a rewrite inserted -- node as a result of a call to Mark_Rewrite_Insertion. @@ -131,65 +108,6 @@ package Atree is -- the flagged node. This is used to avoid posting more -- than one message on the same node. - -- Field1 - -- Field2 - -- Field3 - -- Field4 - -- Field5 Five fields holding Union_Id values - - -- ElistN Synonym for FieldN typed as Elist_Id (Empty = No_Elist) - -- ListN Synonym for FieldN typed as List_Id - -- NameN Synonym for FieldN typed as Name_Id - -- NodeN Synonym for FieldN typed as Node_Id - -- StrN Synonym for FieldN typed as String_Id - -- UintN Synonym for FieldN typed as Uint (Empty = Uint_0) - -- UrealN Synonym for FieldN typed as Ureal - - -- Note: in the case of ElistN and UintN fields, it is common that we - -- end up with a value of Union_Id'(0) as the default value. This value - -- is meaningless as a Uint or Elist_Id value. We have two choices here. - -- We could require that all Uint and Elist fields be initialized to an - -- appropriate value, but that's error prone, since it would be easy to - -- miss an initialization. So instead we have the retrieval functions - -- generate an appropriate default value (Uint_0 or No_Elist). Probably - -- it would be cleaner to generate No_Uint in the Uint case but we got - -- stuck with representing an "unset" size value as zero early on, and - -- it will take a bit of fiddling to change that ??? - - -- Note: the actual usage of FieldN (i.e. whether it contains a Elist_Id, - -- List_Id, Name_Id, Node_Id, String_Id, Uint or Ureal) depends on the - -- value in Nkind. Generally the access to this field is always via the - -- functional interface, so the field names ElistN, ListN, NameN, NodeN, - -- StrN, UintN and UrealN are used only in the bodies of the access - -- functions (i.e. in the bodies of Sinfo and Einfo). These access - -- functions contain debugging code that checks that the use is - -- consistent with Nkind and Ekind values. - - -- However, in specialized circumstances (examples are the circuit in - -- generic instantiation to copy trees, and in the tree dump routine), - -- it is useful to be able to do untyped traversals, and an internal - -- package in Atree allows for direct untyped accesses in such cases. - - -- Flag0 Nineteen Boolean flags (use depends on Nkind and - -- Flag1 Ekind, as described for FieldN). Again the access - -- Flag2 is usually via subprograms in Sinfo and Einfo which - -- Flag3 provide high-level synonyms for these flags, and - -- Flag4 contain debugging code that checks that the values - -- Flag5 in Nkind and Ekind are appropriate for the access. - -- Flag6 - -- Flag7 - -- Flag8 - -- Flag9 - -- Flag10 - -- Flag11 Note that Flag0-3 are stored separately in the Flags - -- Flag12 table, but that's a detail of the implementation which - -- Flag13 is entirely hidden by the functional interface. - -- Flag14 - -- Flag15 - -- Flag16 - -- Flag17 - -- Flag18 - -- Link For a node, points to the Parent. For a list, points -- to the list header. Note that in the latter case, a -- client cannot modify the link field. This field is @@ -203,31 +121,22 @@ package Atree is -- entity, it is of type Entity_Kind which is defined -- in package Einfo. - -- Flag19 299 additional flags - -- ... - -- Flag317 - -- Convention Entity convention (Convention_Id value) - -- Field6 Additional Union_Id value stored in tree - - -- Node6 Synonym for Field6 typed as Node_Id - -- Elist6 Synonym for Field6 typed as Elist_Id (Empty = No_Elist) - -- Uint6 Synonym for Field6 typed as Uint (Empty = Uint_0) - - -- Similar definitions for Field7 to Field41 (and also Node7-Node41, - -- Elist7-Elist41, Uint7-Uint41, Ureal7-Ureal41). Note that not all - -- these functions are defined, only the ones that are actually used. + -- Access to fields is generally done through the getters and setters in + -- packages Sinfo.Nodes and Einfo.Entities. However, in specialized + -- circumstances (examples are the circuit in generic instantiation to copy + -- trees, and in the tree dump routine), it is useful to be able to do + -- untyped traversals, and an internal package in Atree allows for direct + -- untyped accesses in such cases. function Last_Node_Id return Node_Id; - pragma Inline (Last_Node_Id); -- Returns Id of last allocated node Id - function Nodes_Address return System.Address; - -- Return address of Nodes table (used in Back_End for Gigi call) - - function Flags_Address return System.Address; - -- Return address of Flags table (used in Back_End for Gigi call) + function Node_Offsets_Address return System.Address; + function Slots_Address return System.Address; + -- Address of Node_Offsets.Table and Slots.Table. Used in Back_End for Gigi + -- call. function Approx_Num_Nodes_And_Entities return Nat; -- This is an approximation to the number of nodes and entities allocated, @@ -237,19 +146,21 @@ package Atree is -- Use of Empty Node -- ----------------------- - -- The special Node_Id Empty is used to mark missing fields. Whenever the - -- syntax has an optional component, then the corresponding field will be - -- set to Empty if the component is missing. + -- The special Node_Id Empty is used to mark missing fields, similar to + -- "null" in Ada. Whenever the syntax has an optional component, then the + -- corresponding field will be set to Empty if the component is missing. -- Note: Empty is not used to describe an empty list. Instead in this -- case the node field contains a list which is empty, and these cases -- should be distinguished (essentially from a type point of view, Empty - -- is a Node, and is thus not a list). + -- is a Node, not a list). - -- Note: Empty does in fact correspond to an allocated node. Only the - -- Nkind field of this node may be referenced. It contains N_Empty, which + -- Note: Empty does in fact correspond to an allocated node. The Nkind + -- field of this node may be referenced. It contains N_Empty, which -- uniquely identifies the empty case. This allows the Nkind field to be - -- dereferenced before the check for Empty which is sometimes useful. + -- dereferenced before the check for Empty which is sometimes useful. We + -- also access certain other fields of Empty; see comments in + -- Gen_IL.Gen.Gen_Nodes. ----------------------- -- Use of Error Node -- @@ -263,19 +174,18 @@ package Atree is -- If an Error node is encountered, then you know that a previous -- illegality has been detected. The proper reaction should be to -- avoid posting related cascaded error messages, and to propagate - -- the error node if necessary. + -- the Error node if necessary. ------------------------ -- Current_Error_Node -- ------------------------ - -- The current error node is a global location indicating the current - -- node that is being processed for the purposes of placing a compiler + -- Current_Error_Node is a global variable indicating the current node + -- that is being processed for the purposes of placing a compiler -- abort message. This is not necessarily perfectly accurate, it is -- just a reasonably accurate best guess. It is used to output the -- source location in the abort message by Comperr, and also to - -- implement the d3 debugging flag. This is also used by Rtsfind - -- to generate error messages for high integrity mode. + -- implement the d3 debugging flag. -- There are two ways this gets set. During parsing, when new source -- nodes are being constructed by calls to New_Node and New_Entity, @@ -285,8 +195,11 @@ package Atree is -- Debug_A that mark the start and end of analysis/expansion of a -- node in the tree. + -- Current_Error_Node is also used for other purposes. See, for example, + -- Rtsfind. + Current_Error_Node : Node_Id; - -- Node to place error messages + -- Node to place compiler abort messages ------------------ -- Error Counts -- @@ -347,75 +260,34 @@ package Atree is -- bail out, assuming that the anomaly was caused by a previously detected -- serious error (or configurable run time violation). This routine should -- be called in these cases, and will raise an exception if no such error - -- has been detected. This ensure that the anomaly is never allowed to go - -- unnoticed. - - ------------------------------- - -- Default Setting of Fields -- - ------------------------------- - - -- Nkind is set to N_Unused_At_Start - - -- Ekind is set to E_Void - - -- Sloc is always set, there is no default value - - -- Field1-5 fields are set to Empty - - -- Field6-41 fields in extended nodes are set to Empty - - -- Parent is set to Empty - - -- All Boolean flag fields are set to False - - -- Note: the value Empty is used in Field1-Field41 to indicate a null node. - -- The usage varies. The common uses are to indicate absence of an optional - -- clause or a completely unused Field1-35 field. - - ------------------------------------- - -- Use of Synonyms for Node Fields -- - ------------------------------------- - - -- A subpackage Atree.Unchecked_Access provides routines for reading and - -- writing the fields defined above (Field1-35, Node1-35, Flag0-317 etc). - -- These unchecked access routines can be used for untyped traversals. - -- In addition they are used in the implementations of the Sinfo and - -- Einfo packages. These packages both provide logical synonyms for - -- the generic fields, together with an appropriate set of access routines. - -- Normally access to information within tree nodes uses these synonyms, - -- providing a high level typed interface to the tree information. + -- has been detected. This ensures that the anomaly is never allowed to go + -- unnoticed in legal programs. -------------------------------------------------- -- Node Allocation and Modification Subprograms -- -------------------------------------------------- - -- Generally the parser builds the tree and then it is further decorated - -- (e.g. by setting the entity fields), but not fundamentally modified. - -- However, there are cases in which the tree must be restructured by - -- adding and rearranging nodes, as a result of disambiguating cases - -- which the parser could not parse correctly, and adding additional - -- semantic information (e.g. making constraint checks explicit). The - -- following subprograms are used for constructing the tree in the first - -- place, and then for subsequent modifications as required. + -- The following subprograms are used for constructing the tree in the + -- first place, and then for subsequent modifications as required. procedure Initialize; - -- Called at the start of compilation to initialize the allocation of the - -- node and list tables and make the entries for Empty and Error. + -- Called at the start of compilation to make the entries for Empty and + -- Error. procedure Lock; - -- Called before the back end is invoked to lock the nodes table - -- Also called after Unlock to relock??? + -- Called before the back end is invoked to lock the nodes table. + -- Also called after Unlock to relock. + + procedure Unlock; + -- Unlocks nodes table, in cases where the back end needs to modify it procedure Lock_Nodes; -- Called to lock node modifications when assertions are enabled; without -- assertions calling this subprogram has no effect. The initial state of -- the lock is unlocked. - procedure Unlock; - -- Unlocks nodes table, in cases where the back end needs to modify it - procedure Unlock_Nodes; - -- Called to unlock entity modifications when assertions are enabled; if + -- Called to unlock node modifications when assertions are enabled; if -- assertions are not enabled calling this subprogram has no effect. function New_Node @@ -461,20 +333,15 @@ package Atree is -- semantics in the reference manual. This procedure copies the setting -- of Comes_From_Source from OldN to NewN. - function Has_Extension (N : Node_Id) return Boolean; - pragma Inline (Has_Extension); - -- Returns True if the given node has an extension (i.e. was created by - -- a call to New_Entity rather than New_Node, and Nkind is in N_Entity) - - procedure Change_Node (N : Node_Id; New_Node_Kind : Node_Kind); + procedure Change_Node (N : Node_Id; New_Kind : Node_Kind); -- This procedure replaces the given node by setting its Nkind field to -- the indicated value and resetting all other fields to their default -- values except for Sloc, which is unchanged, and the Parent pointer -- and list links, which are also unchanged. All other information in -- the original node is lost. The new node has an extension if the - -- original node had an extension. + -- original node had an extension.????somewhat wrong. - procedure Copy_Node (Source : Node_Id; Destination : Node_Id); + procedure Copy_Node (Source, Destination : Node_Or_Entity_Id); -- Copy the entire contents of the source node to the destination node. -- The contents of the source node is not affected. If the source node -- has an extension, then the destination must have an extension also. @@ -545,16 +412,8 @@ package Atree is -- semantic chains: Homonym and Next_Entity: the corresponding links must -- be adjusted by the caller, according to context. - function Extend_Node (Source : Node_Id) return Entity_Id; - -- This function returns a copy of its input node with an extension added. - -- The fields of the extension are set to Empty. Due to the way extensions - -- are handled (as four consecutive array elements), it may be necessary - -- to reallocate the node, so that the returned value is not the same as - -- the input value, but where possible the returned value will be the same - -- as the input value (i.e. the extension will occur in place). It is the - -- caller's responsibility to ensure that any pointers to the original node - -- are appropriately updated. This function is used only by Sinfo.CN to - -- change nodes into their corresponding entities. + procedure Extend_Node (Source : Node_Id); + -- This turns a node into an entity; it function is used only by Sinfo.CN. type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id); @@ -622,27 +481,6 @@ package Atree is -- The following functions return the contents of the indicated field of -- the node referenced by the argument, which is a Node_Id. - function Analyzed (N : Node_Id) return Boolean; - pragma Inline (Analyzed); - - function Check_Actuals (N : Node_Id) return Boolean; - pragma Inline (Check_Actuals); - - function Comes_From_Source (N : Node_Id) return Boolean; - pragma Inline (Comes_From_Source); - - function Error_Posted (N : Node_Id) return Boolean; - pragma Inline (Error_Posted); - - function Has_Aspects (N : Node_Id) return Boolean; - pragma Inline (Has_Aspects); - - function Is_Ignored_Ghost_Node (N : Node_Id) return Boolean; - pragma Inline (Is_Ignored_Ghost_Node); - - function Nkind (N : Node_Id) return Node_Kind; - pragma Inline (Nkind); - function No (N : Node_Id) return Boolean; pragma Inline (No); -- Tests given Id for equality with the Empty node. This allows notations @@ -655,59 +493,13 @@ package Atree is function Paren_Count (N : Node_Id) return Nat; pragma Inline (Paren_Count); + -- Number of parentheses that surround an expression function Present (N : Node_Id) return Boolean; pragma Inline (Present); -- Tests given Id for inequality with the Empty node. This allows notations -- like "if Present (Statement)" as opposed to "if Statement /= Empty". - function Sloc (N : Node_Id) return Source_Ptr; - pragma Inline (Sloc); - - ----------------------------- - -- Entity Access Functions -- - ----------------------------- - - -- The following functions apply only to Entity_Id values, i.e. - -- to extended nodes. - - function Ekind (E : Entity_Id) return Entity_Kind; - pragma Inline (Ekind); - - function Convention (E : Entity_Id) return Convention_Id; - pragma Inline (Convention); - - ---------------------------- - -- Node Update Procedures -- - ---------------------------- - - -- The following functions set a specified field in the node whose Id is - -- passed as the first argument. The second parameter is the new value - -- to be set in the specified field. Note that Set_Nkind is in the next - -- section, since its use is restricted. - - procedure Set_Analyzed (N : Node_Id; Val : Boolean := True); - pragma Inline (Set_Analyzed); - - procedure Set_Check_Actuals (N : Node_Id; Val : Boolean := True); - pragma Inline (Set_Check_Actuals); - - procedure Set_Comes_From_Source (N : Node_Id; Val : Boolean); - pragma Inline (Set_Comes_From_Source); - -- Note that this routine is very rarely used, since usually the default - -- mechanism provided sets the right value, but in some unusual cases, the - -- value needs to be reset (e.g. when a source node is copied, and the copy - -- must not have Comes_From_Source set). - - procedure Set_Error_Posted (N : Node_Id; Val : Boolean := True); - pragma Inline (Set_Error_Posted); - - procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True); - pragma Inline (Set_Has_Aspects); - - procedure Set_Is_Ignored_Ghost_Node (N : Node_Id; Val : Boolean := True); - pragma Inline (Set_Is_Ignored_Ghost_Node); - procedure Set_Original_Node (N : Node_Id; Val : Node_Id); pragma Inline (Set_Original_Node); -- Note that this routine is used only in very peculiar cases. In normal @@ -719,25 +511,6 @@ package Atree is procedure Set_Paren_Count (N : Node_Id; Val : Nat); pragma Inline (Set_Paren_Count); - procedure Set_Sloc (N : Node_Id; Val : Source_Ptr); - pragma Inline (Set_Sloc); - - ------------------------------ - -- Entity Update Procedures -- - ------------------------------ - - -- The following procedures apply only to Entity_Id values, i.e. - -- to extended nodes. - - procedure Basic_Set_Convention (E : Entity_Id; Val : Convention_Id); - pragma Inline (Basic_Set_Convention); - -- Clients should use Sem_Util.Set_Convention rather than calling this - -- routine directly, as Set_Convention also deals with the special - -- processing required for access types. - - procedure Set_Ekind (E : Entity_Id; Val : Entity_Kind); - pragma Inline (Set_Ekind); - --------------------------- -- Tree Rewrite Routines -- --------------------------- @@ -808,14 +581,16 @@ package Atree is procedure Replace (Old_Node, New_Node : Node_Id); -- This is similar to Rewrite, except that the old value of Old_Node is -- not saved, and the New_Node is deleted after the replace, since it + -- In what sense is it "deleted"???? -- is assumed that it can no longer be legitimately needed. The flag -- Is_Rewrite_Substitution will be False for the resulting node, unless -- it was already true on entry, and Original_Node will not return the -- original contents of the Old_Node, but rather the New_Node value (unless + -- How is this "unless" true???? -- Old_Node had already been rewritten using Rewrite). Replace also -- preserves the setting of Comes_From_Source. -- - -- Note, New_Node may not contain references to Old_Node, for example as + -- Note, New_Node must not contain references to Old_Node, for example as -- descendants, since the rewrite would make such references invalid. If -- New_Node does need to reference Old_Node, then these references should -- be to a relocated copy of Old_Node (see Relocate_Node procedure). @@ -845,2798 +620,61 @@ package Atree is -- a manner that can be reversed later). One possible approach is to use -- Rewrite to substitute a null statement for the node to be deleted. - ----------------------------------- - -- Generic Field Access Routines -- - ----------------------------------- - - -- This subpackage provides the functions for accessing and procedures for - -- setting fields that are normally referenced by wrapper subprograms (e.g. - -- logical synonyms defined in packages Sinfo and Einfo, or specialized - -- routines such as Rewrite (for Original_Node), or the node creation - -- routines (for Set_Nkind). The implementations of these wrapper - -- subprograms use the package Atree.Unchecked_Access as do various - -- special case accesses where no wrapper applies. Documentation is always - -- required for such a special case access explaining why it is needed. - - package Unchecked_Access is - - -- Functions to allow interpretation of Union_Id values as Uint and - -- Ureal values. - - function To_Union is new Unchecked_Conversion (Uint, Union_Id); - function To_Union is new Unchecked_Conversion (Ureal, Union_Id); - - function From_Union is new Unchecked_Conversion (Union_Id, Uint); - function From_Union is new Unchecked_Conversion (Union_Id, Ureal); - - -- Functions to fetch contents of indicated field. It is an error to - -- attempt to read the value of a field which is not present. - - function Field1 (N : Node_Id) return Union_Id; - pragma Inline (Field1); - - function Field2 (N : Node_Id) return Union_Id; - pragma Inline (Field2); - - function Field3 (N : Node_Id) return Union_Id; - pragma Inline (Field3); - - function Field4 (N : Node_Id) return Union_Id; - pragma Inline (Field4); - - function Field5 (N : Node_Id) return Union_Id; - pragma Inline (Field5); - - function Field6 (N : Node_Id) return Union_Id; - pragma Inline (Field6); - - function Field7 (N : Node_Id) return Union_Id; - pragma Inline (Field7); - - function Field8 (N : Node_Id) return Union_Id; - pragma Inline (Field8); - - function Field9 (N : Node_Id) return Union_Id; - pragma Inline (Field9); - - function Field10 (N : Node_Id) return Union_Id; - pragma Inline (Field10); - - function Field11 (N : Node_Id) return Union_Id; - pragma Inline (Field11); - - function Field12 (N : Node_Id) return Union_Id; - pragma Inline (Field12); - - function Field13 (N : Node_Id) return Union_Id; - pragma Inline (Field13); - - function Field14 (N : Node_Id) return Union_Id; - pragma Inline (Field14); - - function Field15 (N : Node_Id) return Union_Id; - pragma Inline (Field15); - - function Field16 (N : Node_Id) return Union_Id; - pragma Inline (Field16); - - function Field17 (N : Node_Id) return Union_Id; - pragma Inline (Field17); - - function Field18 (N : Node_Id) return Union_Id; - pragma Inline (Field18); - - function Field19 (N : Node_Id) return Union_Id; - pragma Inline (Field19); - - function Field20 (N : Node_Id) return Union_Id; - pragma Inline (Field20); - - function Field21 (N : Node_Id) return Union_Id; - pragma Inline (Field21); - - function Field22 (N : Node_Id) return Union_Id; - pragma Inline (Field22); - - function Field23 (N : Node_Id) return Union_Id; - pragma Inline (Field23); - - function Field24 (N : Node_Id) return Union_Id; - pragma Inline (Field24); - - function Field25 (N : Node_Id) return Union_Id; - pragma Inline (Field25); - - function Field26 (N : Node_Id) return Union_Id; - pragma Inline (Field26); - - function Field27 (N : Node_Id) return Union_Id; - pragma Inline (Field27); - - function Field28 (N : Node_Id) return Union_Id; - pragma Inline (Field28); - - function Field29 (N : Node_Id) return Union_Id; - pragma Inline (Field29); - - function Field30 (N : Node_Id) return Union_Id; - pragma Inline (Field30); - - function Field31 (N : Node_Id) return Union_Id; - pragma Inline (Field31); - - function Field32 (N : Node_Id) return Union_Id; - pragma Inline (Field32); - - function Field33 (N : Node_Id) return Union_Id; - pragma Inline (Field33); - - function Field34 (N : Node_Id) return Union_Id; - pragma Inline (Field34); - - function Field35 (N : Node_Id) return Union_Id; - pragma Inline (Field35); - - function Field36 (N : Node_Id) return Union_Id; - pragma Inline (Field36); - - function Field37 (N : Node_Id) return Union_Id; - pragma Inline (Field37); - - function Field38 (N : Node_Id) return Union_Id; - pragma Inline (Field38); - - function Field39 (N : Node_Id) return Union_Id; - pragma Inline (Field39); - - function Field40 (N : Node_Id) return Union_Id; - pragma Inline (Field40); - - function Field41 (N : Node_Id) return Union_Id; - pragma Inline (Field41); - - function Node1 (N : Node_Id) return Node_Id; - pragma Inline (Node1); - - function Node2 (N : Node_Id) return Node_Id; - pragma Inline (Node2); - - function Node3 (N : Node_Id) return Node_Id; - pragma Inline (Node3); - - function Node4 (N : Node_Id) return Node_Id; - pragma Inline (Node4); - - function Node5 (N : Node_Id) return Node_Id; - pragma Inline (Node5); - - function Node6 (N : Node_Id) return Node_Id; - pragma Inline (Node6); - - function Node7 (N : Node_Id) return Node_Id; - pragma Inline (Node7); - - function Node8 (N : Node_Id) return Node_Id; - pragma Inline (Node8); - - function Node9 (N : Node_Id) return Node_Id; - pragma Inline (Node9); - - function Node10 (N : Node_Id) return Node_Id; - pragma Inline (Node10); - - function Node11 (N : Node_Id) return Node_Id; - pragma Inline (Node11); - - function Node12 (N : Node_Id) return Node_Id; - pragma Inline (Node12); - - function Node13 (N : Node_Id) return Node_Id; - pragma Inline (Node13); - - function Node14 (N : Node_Id) return Node_Id; - pragma Inline (Node14); - - function Node15 (N : Node_Id) return Node_Id; - pragma Inline (Node15); - - function Node16 (N : Node_Id) return Node_Id; - pragma Inline (Node16); - - function Node17 (N : Node_Id) return Node_Id; - pragma Inline (Node17); - - function Node18 (N : Node_Id) return Node_Id; - pragma Inline (Node18); - - function Node19 (N : Node_Id) return Node_Id; - pragma Inline (Node19); - - function Node20 (N : Node_Id) return Node_Id; - pragma Inline (Node20); - - function Node21 (N : Node_Id) return Node_Id; - pragma Inline (Node21); - - function Node22 (N : Node_Id) return Node_Id; - pragma Inline (Node22); - - function Node23 (N : Node_Id) return Node_Id; - pragma Inline (Node23); - - function Node24 (N : Node_Id) return Node_Id; - pragma Inline (Node24); - - function Node25 (N : Node_Id) return Node_Id; - pragma Inline (Node25); - - function Node26 (N : Node_Id) return Node_Id; - pragma Inline (Node26); - - function Node27 (N : Node_Id) return Node_Id; - pragma Inline (Node27); - - function Node28 (N : Node_Id) return Node_Id; - pragma Inline (Node28); - - function Node29 (N : Node_Id) return Node_Id; - pragma Inline (Node29); - - function Node30 (N : Node_Id) return Node_Id; - pragma Inline (Node30); - - function Node31 (N : Node_Id) return Node_Id; - pragma Inline (Node31); - - function Node32 (N : Node_Id) return Node_Id; - pragma Inline (Node32); - - function Node33 (N : Node_Id) return Node_Id; - pragma Inline (Node33); - - function Node34 (N : Node_Id) return Node_Id; - pragma Inline (Node34); - - function Node35 (N : Node_Id) return Node_Id; - pragma Inline (Node35); - - function Node36 (N : Node_Id) return Node_Id; - pragma Inline (Node36); - - function Node37 (N : Node_Id) return Node_Id; - pragma Inline (Node37); - - function Node38 (N : Node_Id) return Node_Id; - pragma Inline (Node38); - - function Node39 (N : Node_Id) return Node_Id; - pragma Inline (Node39); - - function Node40 (N : Node_Id) return Node_Id; - pragma Inline (Node40); - - function Node41 (N : Node_Id) return Node_Id; - pragma Inline (Node41); - - function List1 (N : Node_Id) return List_Id; - pragma Inline (List1); - - function List2 (N : Node_Id) return List_Id; - pragma Inline (List2); - - function List3 (N : Node_Id) return List_Id; - pragma Inline (List3); - - function List4 (N : Node_Id) return List_Id; - pragma Inline (List4); - - function List5 (N : Node_Id) return List_Id; - pragma Inline (List5); - - function List10 (N : Node_Id) return List_Id; - pragma Inline (List10); - - function List14 (N : Node_Id) return List_Id; - pragma Inline (List14); - - function List25 (N : Node_Id) return List_Id; - pragma Inline (List25); - - function List38 (N : Node_Id) return List_Id; - pragma Inline (List38); - - function List39 (N : Node_Id) return List_Id; - pragma Inline (List39); - - function Elist1 (N : Node_Id) return Elist_Id; - pragma Inline (Elist1); - - function Elist2 (N : Node_Id) return Elist_Id; - pragma Inline (Elist2); - - function Elist3 (N : Node_Id) return Elist_Id; - pragma Inline (Elist3); - - function Elist4 (N : Node_Id) return Elist_Id; - pragma Inline (Elist4); - - function Elist5 (N : Node_Id) return Elist_Id; - pragma Inline (Elist5); - - function Elist8 (N : Node_Id) return Elist_Id; - pragma Inline (Elist8); - - function Elist9 (N : Node_Id) return Elist_Id; - pragma Inline (Elist9); - - function Elist10 (N : Node_Id) return Elist_Id; - pragma Inline (Elist10); - - function Elist11 (N : Node_Id) return Elist_Id; - pragma Inline (Elist11); - - function Elist13 (N : Node_Id) return Elist_Id; - pragma Inline (Elist13); - - function Elist15 (N : Node_Id) return Elist_Id; - pragma Inline (Elist15); - - function Elist16 (N : Node_Id) return Elist_Id; - pragma Inline (Elist16); - - function Elist18 (N : Node_Id) return Elist_Id; - pragma Inline (Elist18); - - function Elist21 (N : Node_Id) return Elist_Id; - pragma Inline (Elist21); - - function Elist23 (N : Node_Id) return Elist_Id; - pragma Inline (Elist23); - - function Elist24 (N : Node_Id) return Elist_Id; - pragma Inline (Elist24); - - function Elist25 (N : Node_Id) return Elist_Id; - pragma Inline (Elist25); - - function Elist26 (N : Node_Id) return Elist_Id; - pragma Inline (Elist26); - - function Elist29 (N : Node_Id) return Elist_Id; - pragma Inline (Elist29); - - function Elist30 (N : Node_Id) return Elist_Id; - pragma Inline (Elist30); - - function Elist36 (N : Node_Id) return Elist_Id; - pragma Inline (Elist36); - - function Name1 (N : Node_Id) return Name_Id; - pragma Inline (Name1); - - function Name2 (N : Node_Id) return Name_Id; - pragma Inline (Name2); - - function Str3 (N : Node_Id) return String_Id; - pragma Inline (Str3); - - -- Note: the following Uintnn functions have a special test for the - -- Field value being Empty. If an Empty value is found then Uint_0 is - -- returned. This avoids the rather tricky requirement of initializing - -- all Uint fields in nodes and entities. - - function Uint2 (N : Node_Id) return Uint; - pragma Inline (Uint2); - - function Uint3 (N : Node_Id) return Uint; - pragma Inline (Uint3); - - function Uint4 (N : Node_Id) return Uint; - pragma Inline (Uint4); - - function Uint5 (N : Node_Id) return Uint; - pragma Inline (Uint5); - - function Uint8 (N : Node_Id) return Uint; - pragma Inline (Uint8); - - function Uint9 (N : Node_Id) return Uint; - pragma Inline (Uint9); - - function Uint10 (N : Node_Id) return Uint; - pragma Inline (Uint10); - - function Uint11 (N : Node_Id) return Uint; - pragma Inline (Uint11); - - function Uint12 (N : Node_Id) return Uint; - pragma Inline (Uint12); - - function Uint13 (N : Node_Id) return Uint; - pragma Inline (Uint13); - - function Uint14 (N : Node_Id) return Uint; - pragma Inline (Uint14); - - function Uint15 (N : Node_Id) return Uint; - pragma Inline (Uint15); - - function Uint16 (N : Node_Id) return Uint; - pragma Inline (Uint16); - - function Uint17 (N : Node_Id) return Uint; - pragma Inline (Uint17); - - function Uint22 (N : Node_Id) return Uint; - pragma Inline (Uint22); - - function Uint24 (N : Node_Id) return Uint; - pragma Inline (Uint24); - - function Ureal3 (N : Node_Id) return Ureal; - pragma Inline (Ureal3); - - function Ureal18 (N : Node_Id) return Ureal; - pragma Inline (Ureal18); - - function Ureal21 (N : Node_Id) return Ureal; - pragma Inline (Ureal21); - - function Flag0 (N : Node_Id) return Boolean; - pragma Inline (Flag0); - - function Flag1 (N : Node_Id) return Boolean; - pragma Inline (Flag1); - - function Flag2 (N : Node_Id) return Boolean; - pragma Inline (Flag2); - - function Flag3 (N : Node_Id) return Boolean; - pragma Inline (Flag3); - - function Flag4 (N : Node_Id) return Boolean; - pragma Inline (Flag4); - - function Flag5 (N : Node_Id) return Boolean; - pragma Inline (Flag5); - - function Flag6 (N : Node_Id) return Boolean; - pragma Inline (Flag6); - - function Flag7 (N : Node_Id) return Boolean; - pragma Inline (Flag7); - - function Flag8 (N : Node_Id) return Boolean; - pragma Inline (Flag8); - - function Flag9 (N : Node_Id) return Boolean; - pragma Inline (Flag9); - - function Flag10 (N : Node_Id) return Boolean; - pragma Inline (Flag10); - - function Flag11 (N : Node_Id) return Boolean; - pragma Inline (Flag11); - - function Flag12 (N : Node_Id) return Boolean; - pragma Inline (Flag12); - - function Flag13 (N : Node_Id) return Boolean; - pragma Inline (Flag13); - - function Flag14 (N : Node_Id) return Boolean; - pragma Inline (Flag14); - - function Flag15 (N : Node_Id) return Boolean; - pragma Inline (Flag15); - - function Flag16 (N : Node_Id) return Boolean; - pragma Inline (Flag16); - - function Flag17 (N : Node_Id) return Boolean; - pragma Inline (Flag17); - - function Flag18 (N : Node_Id) return Boolean; - pragma Inline (Flag18); - - function Flag19 (N : Node_Id) return Boolean; - pragma Inline (Flag19); - - function Flag20 (N : Node_Id) return Boolean; - pragma Inline (Flag20); - - function Flag21 (N : Node_Id) return Boolean; - pragma Inline (Flag21); - - function Flag22 (N : Node_Id) return Boolean; - pragma Inline (Flag22); - - function Flag23 (N : Node_Id) return Boolean; - pragma Inline (Flag23); - - function Flag24 (N : Node_Id) return Boolean; - pragma Inline (Flag24); - - function Flag25 (N : Node_Id) return Boolean; - pragma Inline (Flag25); - - function Flag26 (N : Node_Id) return Boolean; - pragma Inline (Flag26); - - function Flag27 (N : Node_Id) return Boolean; - pragma Inline (Flag27); - - function Flag28 (N : Node_Id) return Boolean; - pragma Inline (Flag28); - - function Flag29 (N : Node_Id) return Boolean; - pragma Inline (Flag29); - - function Flag30 (N : Node_Id) return Boolean; - pragma Inline (Flag30); - - function Flag31 (N : Node_Id) return Boolean; - pragma Inline (Flag31); - - function Flag32 (N : Node_Id) return Boolean; - pragma Inline (Flag32); - - function Flag33 (N : Node_Id) return Boolean; - pragma Inline (Flag33); - - function Flag34 (N : Node_Id) return Boolean; - pragma Inline (Flag34); - - function Flag35 (N : Node_Id) return Boolean; - pragma Inline (Flag35); - - function Flag36 (N : Node_Id) return Boolean; - pragma Inline (Flag36); - - function Flag37 (N : Node_Id) return Boolean; - pragma Inline (Flag37); - - function Flag38 (N : Node_Id) return Boolean; - pragma Inline (Flag38); - - function Flag39 (N : Node_Id) return Boolean; - pragma Inline (Flag39); - - function Flag40 (N : Node_Id) return Boolean; - pragma Inline (Flag40); - - function Flag41 (N : Node_Id) return Boolean; - pragma Inline (Flag41); - - function Flag42 (N : Node_Id) return Boolean; - pragma Inline (Flag42); - - function Flag43 (N : Node_Id) return Boolean; - pragma Inline (Flag43); - - function Flag44 (N : Node_Id) return Boolean; - pragma Inline (Flag44); - - function Flag45 (N : Node_Id) return Boolean; - pragma Inline (Flag45); - - function Flag46 (N : Node_Id) return Boolean; - pragma Inline (Flag46); - - function Flag47 (N : Node_Id) return Boolean; - pragma Inline (Flag47); - - function Flag48 (N : Node_Id) return Boolean; - pragma Inline (Flag48); - - function Flag49 (N : Node_Id) return Boolean; - pragma Inline (Flag49); - - function Flag50 (N : Node_Id) return Boolean; - pragma Inline (Flag50); - - function Flag51 (N : Node_Id) return Boolean; - pragma Inline (Flag51); - - function Flag52 (N : Node_Id) return Boolean; - pragma Inline (Flag52); - - function Flag53 (N : Node_Id) return Boolean; - pragma Inline (Flag53); - - function Flag54 (N : Node_Id) return Boolean; - pragma Inline (Flag54); - - function Flag55 (N : Node_Id) return Boolean; - pragma Inline (Flag55); - - function Flag56 (N : Node_Id) return Boolean; - pragma Inline (Flag56); - - function Flag57 (N : Node_Id) return Boolean; - pragma Inline (Flag57); - - function Flag58 (N : Node_Id) return Boolean; - pragma Inline (Flag58); - - function Flag59 (N : Node_Id) return Boolean; - pragma Inline (Flag59); - - function Flag60 (N : Node_Id) return Boolean; - pragma Inline (Flag60); - - function Flag61 (N : Node_Id) return Boolean; - pragma Inline (Flag61); - - function Flag62 (N : Node_Id) return Boolean; - pragma Inline (Flag62); - - function Flag63 (N : Node_Id) return Boolean; - pragma Inline (Flag63); - - function Flag64 (N : Node_Id) return Boolean; - pragma Inline (Flag64); - - function Flag65 (N : Node_Id) return Boolean; - pragma Inline (Flag65); - - function Flag66 (N : Node_Id) return Boolean; - pragma Inline (Flag66); - - function Flag67 (N : Node_Id) return Boolean; - pragma Inline (Flag67); - - function Flag68 (N : Node_Id) return Boolean; - pragma Inline (Flag68); - - function Flag69 (N : Node_Id) return Boolean; - pragma Inline (Flag69); - - function Flag70 (N : Node_Id) return Boolean; - pragma Inline (Flag70); - - function Flag71 (N : Node_Id) return Boolean; - pragma Inline (Flag71); - - function Flag72 (N : Node_Id) return Boolean; - pragma Inline (Flag72); - - function Flag73 (N : Node_Id) return Boolean; - pragma Inline (Flag73); - - function Flag74 (N : Node_Id) return Boolean; - pragma Inline (Flag74); - - function Flag75 (N : Node_Id) return Boolean; - pragma Inline (Flag75); - - function Flag76 (N : Node_Id) return Boolean; - pragma Inline (Flag76); - - function Flag77 (N : Node_Id) return Boolean; - pragma Inline (Flag77); - - function Flag78 (N : Node_Id) return Boolean; - pragma Inline (Flag78); - - function Flag79 (N : Node_Id) return Boolean; - pragma Inline (Flag79); - - function Flag80 (N : Node_Id) return Boolean; - pragma Inline (Flag80); - - function Flag81 (N : Node_Id) return Boolean; - pragma Inline (Flag81); - - function Flag82 (N : Node_Id) return Boolean; - pragma Inline (Flag82); - - function Flag83 (N : Node_Id) return Boolean; - pragma Inline (Flag83); - - function Flag84 (N : Node_Id) return Boolean; - pragma Inline (Flag84); - - function Flag85 (N : Node_Id) return Boolean; - pragma Inline (Flag85); - - function Flag86 (N : Node_Id) return Boolean; - pragma Inline (Flag86); - - function Flag87 (N : Node_Id) return Boolean; - pragma Inline (Flag87); - - function Flag88 (N : Node_Id) return Boolean; - pragma Inline (Flag88); - - function Flag89 (N : Node_Id) return Boolean; - pragma Inline (Flag89); - - function Flag90 (N : Node_Id) return Boolean; - pragma Inline (Flag90); - - function Flag91 (N : Node_Id) return Boolean; - pragma Inline (Flag91); - - function Flag92 (N : Node_Id) return Boolean; - pragma Inline (Flag92); - - function Flag93 (N : Node_Id) return Boolean; - pragma Inline (Flag93); - - function Flag94 (N : Node_Id) return Boolean; - pragma Inline (Flag94); - - function Flag95 (N : Node_Id) return Boolean; - pragma Inline (Flag95); - - function Flag96 (N : Node_Id) return Boolean; - pragma Inline (Flag96); - - function Flag97 (N : Node_Id) return Boolean; - pragma Inline (Flag97); - - function Flag98 (N : Node_Id) return Boolean; - pragma Inline (Flag98); - - function Flag99 (N : Node_Id) return Boolean; - pragma Inline (Flag99); - - function Flag100 (N : Node_Id) return Boolean; - pragma Inline (Flag100); - - function Flag101 (N : Node_Id) return Boolean; - pragma Inline (Flag101); - - function Flag102 (N : Node_Id) return Boolean; - pragma Inline (Flag102); - - function Flag103 (N : Node_Id) return Boolean; - pragma Inline (Flag103); - - function Flag104 (N : Node_Id) return Boolean; - pragma Inline (Flag104); - - function Flag105 (N : Node_Id) return Boolean; - pragma Inline (Flag105); - - function Flag106 (N : Node_Id) return Boolean; - pragma Inline (Flag106); - - function Flag107 (N : Node_Id) return Boolean; - pragma Inline (Flag107); - - function Flag108 (N : Node_Id) return Boolean; - pragma Inline (Flag108); - - function Flag109 (N : Node_Id) return Boolean; - pragma Inline (Flag109); - - function Flag110 (N : Node_Id) return Boolean; - pragma Inline (Flag110); - - function Flag111 (N : Node_Id) return Boolean; - pragma Inline (Flag111); - - function Flag112 (N : Node_Id) return Boolean; - pragma Inline (Flag112); - - function Flag113 (N : Node_Id) return Boolean; - pragma Inline (Flag113); - - function Flag114 (N : Node_Id) return Boolean; - pragma Inline (Flag114); - - function Flag115 (N : Node_Id) return Boolean; - pragma Inline (Flag115); - - function Flag116 (N : Node_Id) return Boolean; - pragma Inline (Flag116); - - function Flag117 (N : Node_Id) return Boolean; - pragma Inline (Flag117); - - function Flag118 (N : Node_Id) return Boolean; - pragma Inline (Flag118); - - function Flag119 (N : Node_Id) return Boolean; - pragma Inline (Flag119); - - function Flag120 (N : Node_Id) return Boolean; - pragma Inline (Flag120); - - function Flag121 (N : Node_Id) return Boolean; - pragma Inline (Flag121); - - function Flag122 (N : Node_Id) return Boolean; - pragma Inline (Flag122); - - function Flag123 (N : Node_Id) return Boolean; - pragma Inline (Flag123); - - function Flag124 (N : Node_Id) return Boolean; - pragma Inline (Flag124); - - function Flag125 (N : Node_Id) return Boolean; - pragma Inline (Flag125); - - function Flag126 (N : Node_Id) return Boolean; - pragma Inline (Flag126); - - function Flag127 (N : Node_Id) return Boolean; - pragma Inline (Flag127); - - function Flag128 (N : Node_Id) return Boolean; - pragma Inline (Flag128); - - function Flag129 (N : Node_Id) return Boolean; - pragma Inline (Flag129); - - function Flag130 (N : Node_Id) return Boolean; - pragma Inline (Flag130); - - function Flag131 (N : Node_Id) return Boolean; - pragma Inline (Flag131); - - function Flag132 (N : Node_Id) return Boolean; - pragma Inline (Flag132); - - function Flag133 (N : Node_Id) return Boolean; - pragma Inline (Flag133); - - function Flag134 (N : Node_Id) return Boolean; - pragma Inline (Flag134); - - function Flag135 (N : Node_Id) return Boolean; - pragma Inline (Flag135); - - function Flag136 (N : Node_Id) return Boolean; - pragma Inline (Flag136); - - function Flag137 (N : Node_Id) return Boolean; - pragma Inline (Flag137); - - function Flag138 (N : Node_Id) return Boolean; - pragma Inline (Flag138); - - function Flag139 (N : Node_Id) return Boolean; - pragma Inline (Flag139); - - function Flag140 (N : Node_Id) return Boolean; - pragma Inline (Flag140); - - function Flag141 (N : Node_Id) return Boolean; - pragma Inline (Flag141); - - function Flag142 (N : Node_Id) return Boolean; - pragma Inline (Flag142); - - function Flag143 (N : Node_Id) return Boolean; - pragma Inline (Flag143); - - function Flag144 (N : Node_Id) return Boolean; - pragma Inline (Flag144); - - function Flag145 (N : Node_Id) return Boolean; - pragma Inline (Flag145); - - function Flag146 (N : Node_Id) return Boolean; - pragma Inline (Flag146); - - function Flag147 (N : Node_Id) return Boolean; - pragma Inline (Flag147); - - function Flag148 (N : Node_Id) return Boolean; - pragma Inline (Flag148); - - function Flag149 (N : Node_Id) return Boolean; - pragma Inline (Flag149); - - function Flag150 (N : Node_Id) return Boolean; - pragma Inline (Flag150); - - function Flag151 (N : Node_Id) return Boolean; - pragma Inline (Flag151); - - function Flag152 (N : Node_Id) return Boolean; - pragma Inline (Flag152); - - function Flag153 (N : Node_Id) return Boolean; - pragma Inline (Flag153); - - function Flag154 (N : Node_Id) return Boolean; - pragma Inline (Flag154); - - function Flag155 (N : Node_Id) return Boolean; - pragma Inline (Flag155); - - function Flag156 (N : Node_Id) return Boolean; - pragma Inline (Flag156); - - function Flag157 (N : Node_Id) return Boolean; - pragma Inline (Flag157); - - function Flag158 (N : Node_Id) return Boolean; - pragma Inline (Flag158); - - function Flag159 (N : Node_Id) return Boolean; - pragma Inline (Flag159); - - function Flag160 (N : Node_Id) return Boolean; - pragma Inline (Flag160); - - function Flag161 (N : Node_Id) return Boolean; - pragma Inline (Flag161); - - function Flag162 (N : Node_Id) return Boolean; - pragma Inline (Flag162); - - function Flag163 (N : Node_Id) return Boolean; - pragma Inline (Flag163); - - function Flag164 (N : Node_Id) return Boolean; - pragma Inline (Flag164); - - function Flag165 (N : Node_Id) return Boolean; - pragma Inline (Flag165); - - function Flag166 (N : Node_Id) return Boolean; - pragma Inline (Flag166); - - function Flag167 (N : Node_Id) return Boolean; - pragma Inline (Flag167); - - function Flag168 (N : Node_Id) return Boolean; - pragma Inline (Flag168); - - function Flag169 (N : Node_Id) return Boolean; - pragma Inline (Flag169); - - function Flag170 (N : Node_Id) return Boolean; - pragma Inline (Flag170); - - function Flag171 (N : Node_Id) return Boolean; - pragma Inline (Flag171); - - function Flag172 (N : Node_Id) return Boolean; - pragma Inline (Flag172); - - function Flag173 (N : Node_Id) return Boolean; - pragma Inline (Flag173); - - function Flag174 (N : Node_Id) return Boolean; - pragma Inline (Flag174); - - function Flag175 (N : Node_Id) return Boolean; - pragma Inline (Flag175); - - function Flag176 (N : Node_Id) return Boolean; - pragma Inline (Flag176); - - function Flag177 (N : Node_Id) return Boolean; - pragma Inline (Flag177); - - function Flag178 (N : Node_Id) return Boolean; - pragma Inline (Flag178); - - function Flag179 (N : Node_Id) return Boolean; - pragma Inline (Flag179); - - function Flag180 (N : Node_Id) return Boolean; - pragma Inline (Flag180); - - function Flag181 (N : Node_Id) return Boolean; - pragma Inline (Flag181); - - function Flag182 (N : Node_Id) return Boolean; - pragma Inline (Flag182); - - function Flag183 (N : Node_Id) return Boolean; - pragma Inline (Flag183); - - function Flag184 (N : Node_Id) return Boolean; - pragma Inline (Flag184); - - function Flag185 (N : Node_Id) return Boolean; - pragma Inline (Flag185); - - function Flag186 (N : Node_Id) return Boolean; - pragma Inline (Flag186); - - function Flag187 (N : Node_Id) return Boolean; - pragma Inline (Flag187); - - function Flag188 (N : Node_Id) return Boolean; - pragma Inline (Flag188); - - function Flag189 (N : Node_Id) return Boolean; - pragma Inline (Flag189); - - function Flag190 (N : Node_Id) return Boolean; - pragma Inline (Flag190); - - function Flag191 (N : Node_Id) return Boolean; - pragma Inline (Flag191); - - function Flag192 (N : Node_Id) return Boolean; - pragma Inline (Flag192); - - function Flag193 (N : Node_Id) return Boolean; - pragma Inline (Flag193); - - function Flag194 (N : Node_Id) return Boolean; - pragma Inline (Flag194); - - function Flag195 (N : Node_Id) return Boolean; - pragma Inline (Flag195); - - function Flag196 (N : Node_Id) return Boolean; - pragma Inline (Flag196); - - function Flag197 (N : Node_Id) return Boolean; - pragma Inline (Flag197); - - function Flag198 (N : Node_Id) return Boolean; - pragma Inline (Flag198); - - function Flag199 (N : Node_Id) return Boolean; - pragma Inline (Flag199); - - function Flag200 (N : Node_Id) return Boolean; - pragma Inline (Flag200); - - function Flag201 (N : Node_Id) return Boolean; - pragma Inline (Flag201); - - function Flag202 (N : Node_Id) return Boolean; - pragma Inline (Flag202); - - function Flag203 (N : Node_Id) return Boolean; - pragma Inline (Flag203); - - function Flag204 (N : Node_Id) return Boolean; - pragma Inline (Flag204); - - function Flag205 (N : Node_Id) return Boolean; - pragma Inline (Flag205); - - function Flag206 (N : Node_Id) return Boolean; - pragma Inline (Flag206); - - function Flag207 (N : Node_Id) return Boolean; - pragma Inline (Flag207); - - function Flag208 (N : Node_Id) return Boolean; - pragma Inline (Flag208); - - function Flag209 (N : Node_Id) return Boolean; - pragma Inline (Flag209); - - function Flag210 (N : Node_Id) return Boolean; - pragma Inline (Flag210); - - function Flag211 (N : Node_Id) return Boolean; - pragma Inline (Flag211); - - function Flag212 (N : Node_Id) return Boolean; - pragma Inline (Flag212); - - function Flag213 (N : Node_Id) return Boolean; - pragma Inline (Flag213); - - function Flag214 (N : Node_Id) return Boolean; - pragma Inline (Flag214); - - function Flag215 (N : Node_Id) return Boolean; - pragma Inline (Flag215); - - function Flag216 (N : Node_Id) return Boolean; - pragma Inline (Flag216); - - function Flag217 (N : Node_Id) return Boolean; - pragma Inline (Flag217); - - function Flag218 (N : Node_Id) return Boolean; - pragma Inline (Flag218); - - function Flag219 (N : Node_Id) return Boolean; - pragma Inline (Flag219); - - function Flag220 (N : Node_Id) return Boolean; - pragma Inline (Flag220); - - function Flag221 (N : Node_Id) return Boolean; - pragma Inline (Flag221); - - function Flag222 (N : Node_Id) return Boolean; - pragma Inline (Flag222); - - function Flag223 (N : Node_Id) return Boolean; - pragma Inline (Flag223); - - function Flag224 (N : Node_Id) return Boolean; - pragma Inline (Flag224); - - function Flag225 (N : Node_Id) return Boolean; - pragma Inline (Flag225); - - function Flag226 (N : Node_Id) return Boolean; - pragma Inline (Flag226); - - function Flag227 (N : Node_Id) return Boolean; - pragma Inline (Flag227); - - function Flag228 (N : Node_Id) return Boolean; - pragma Inline (Flag228); - - function Flag229 (N : Node_Id) return Boolean; - pragma Inline (Flag229); - - function Flag230 (N : Node_Id) return Boolean; - pragma Inline (Flag230); - - function Flag231 (N : Node_Id) return Boolean; - pragma Inline (Flag231); - - function Flag232 (N : Node_Id) return Boolean; - pragma Inline (Flag232); - - function Flag233 (N : Node_Id) return Boolean; - pragma Inline (Flag233); - - function Flag234 (N : Node_Id) return Boolean; - pragma Inline (Flag234); - - function Flag235 (N : Node_Id) return Boolean; - pragma Inline (Flag235); - - function Flag236 (N : Node_Id) return Boolean; - pragma Inline (Flag236); - - function Flag237 (N : Node_Id) return Boolean; - pragma Inline (Flag237); - - function Flag238 (N : Node_Id) return Boolean; - pragma Inline (Flag238); - - function Flag239 (N : Node_Id) return Boolean; - pragma Inline (Flag239); - - function Flag240 (N : Node_Id) return Boolean; - pragma Inline (Flag240); - - function Flag241 (N : Node_Id) return Boolean; - pragma Inline (Flag241); - - function Flag242 (N : Node_Id) return Boolean; - pragma Inline (Flag242); - - function Flag243 (N : Node_Id) return Boolean; - pragma Inline (Flag243); - - function Flag244 (N : Node_Id) return Boolean; - pragma Inline (Flag244); - - function Flag245 (N : Node_Id) return Boolean; - pragma Inline (Flag245); - - function Flag246 (N : Node_Id) return Boolean; - pragma Inline (Flag246); - - function Flag247 (N : Node_Id) return Boolean; - pragma Inline (Flag247); - - function Flag248 (N : Node_Id) return Boolean; - pragma Inline (Flag248); - - function Flag249 (N : Node_Id) return Boolean; - pragma Inline (Flag249); - - function Flag250 (N : Node_Id) return Boolean; - pragma Inline (Flag250); - - function Flag251 (N : Node_Id) return Boolean; - pragma Inline (Flag251); - - function Flag252 (N : Node_Id) return Boolean; - pragma Inline (Flag252); - - function Flag253 (N : Node_Id) return Boolean; - pragma Inline (Flag253); - - function Flag254 (N : Node_Id) return Boolean; - pragma Inline (Flag254); - - function Flag255 (N : Node_Id) return Boolean; - pragma Inline (Flag255); - - function Flag256 (N : Node_Id) return Boolean; - pragma Inline (Flag256); - - function Flag257 (N : Node_Id) return Boolean; - pragma Inline (Flag257); - - function Flag258 (N : Node_Id) return Boolean; - pragma Inline (Flag258); - - function Flag259 (N : Node_Id) return Boolean; - pragma Inline (Flag259); - - function Flag260 (N : Node_Id) return Boolean; - pragma Inline (Flag260); - - function Flag261 (N : Node_Id) return Boolean; - pragma Inline (Flag261); - - function Flag262 (N : Node_Id) return Boolean; - pragma Inline (Flag262); - - function Flag263 (N : Node_Id) return Boolean; - pragma Inline (Flag263); - - function Flag264 (N : Node_Id) return Boolean; - pragma Inline (Flag264); - - function Flag265 (N : Node_Id) return Boolean; - pragma Inline (Flag265); - - function Flag266 (N : Node_Id) return Boolean; - pragma Inline (Flag266); - - function Flag267 (N : Node_Id) return Boolean; - pragma Inline (Flag267); - - function Flag268 (N : Node_Id) return Boolean; - pragma Inline (Flag268); - - function Flag269 (N : Node_Id) return Boolean; - pragma Inline (Flag269); - - function Flag270 (N : Node_Id) return Boolean; - pragma Inline (Flag270); - - function Flag271 (N : Node_Id) return Boolean; - pragma Inline (Flag271); - - function Flag272 (N : Node_Id) return Boolean; - pragma Inline (Flag272); - - function Flag273 (N : Node_Id) return Boolean; - pragma Inline (Flag273); - - function Flag274 (N : Node_Id) return Boolean; - pragma Inline (Flag274); - - function Flag275 (N : Node_Id) return Boolean; - pragma Inline (Flag275); - - function Flag276 (N : Node_Id) return Boolean; - pragma Inline (Flag276); - - function Flag277 (N : Node_Id) return Boolean; - pragma Inline (Flag277); - - function Flag278 (N : Node_Id) return Boolean; - pragma Inline (Flag278); - - function Flag279 (N : Node_Id) return Boolean; - pragma Inline (Flag279); - - function Flag280 (N : Node_Id) return Boolean; - pragma Inline (Flag280); - - function Flag281 (N : Node_Id) return Boolean; - pragma Inline (Flag281); - - function Flag282 (N : Node_Id) return Boolean; - pragma Inline (Flag282); - - function Flag283 (N : Node_Id) return Boolean; - pragma Inline (Flag283); - - function Flag284 (N : Node_Id) return Boolean; - pragma Inline (Flag284); - - function Flag285 (N : Node_Id) return Boolean; - pragma Inline (Flag285); - - function Flag286 (N : Node_Id) return Boolean; - pragma Inline (Flag286); - - function Flag287 (N : Node_Id) return Boolean; - pragma Inline (Flag287); - - function Flag288 (N : Node_Id) return Boolean; - pragma Inline (Flag288); - - function Flag289 (N : Node_Id) return Boolean; - pragma Inline (Flag289); - - function Flag290 (N : Node_Id) return Boolean; - pragma Inline (Flag290); - - function Flag291 (N : Node_Id) return Boolean; - pragma Inline (Flag291); - - function Flag292 (N : Node_Id) return Boolean; - pragma Inline (Flag292); - - function Flag293 (N : Node_Id) return Boolean; - pragma Inline (Flag293); - - function Flag294 (N : Node_Id) return Boolean; - pragma Inline (Flag294); - - function Flag295 (N : Node_Id) return Boolean; - pragma Inline (Flag295); - - function Flag296 (N : Node_Id) return Boolean; - pragma Inline (Flag296); - - function Flag297 (N : Node_Id) return Boolean; - pragma Inline (Flag297); - - function Flag298 (N : Node_Id) return Boolean; - pragma Inline (Flag298); - - function Flag299 (N : Node_Id) return Boolean; - pragma Inline (Flag299); - - function Flag300 (N : Node_Id) return Boolean; - pragma Inline (Flag300); - - function Flag301 (N : Node_Id) return Boolean; - pragma Inline (Flag301); - - function Flag302 (N : Node_Id) return Boolean; - pragma Inline (Flag302); - - function Flag303 (N : Node_Id) return Boolean; - pragma Inline (Flag303); - - function Flag304 (N : Node_Id) return Boolean; - pragma Inline (Flag304); - - function Flag305 (N : Node_Id) return Boolean; - pragma Inline (Flag305); - - function Flag306 (N : Node_Id) return Boolean; - pragma Inline (Flag306); - - function Flag307 (N : Node_Id) return Boolean; - pragma Inline (Flag307); - - function Flag308 (N : Node_Id) return Boolean; - pragma Inline (Flag308); - - function Flag309 (N : Node_Id) return Boolean; - pragma Inline (Flag309); - - function Flag310 (N : Node_Id) return Boolean; - pragma Inline (Flag310); - - function Flag311 (N : Node_Id) return Boolean; - pragma Inline (Flag311); - - function Flag312 (N : Node_Id) return Boolean; - pragma Inline (Flag312); - - function Flag313 (N : Node_Id) return Boolean; - pragma Inline (Flag313); - - function Flag314 (N : Node_Id) return Boolean; - pragma Inline (Flag314); - - function Flag315 (N : Node_Id) return Boolean; - pragma Inline (Flag315); - - function Flag316 (N : Node_Id) return Boolean; - pragma Inline (Flag316); - - function Flag317 (N : Node_Id) return Boolean; - pragma Inline (Flag317); - - -- Procedures to set value of indicated field - - procedure Set_Nkind (N : Node_Id; Val : Node_Kind); - pragma Inline (Set_Nkind); - - procedure Set_Field1 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field1); - - procedure Set_Field2 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field2); - - procedure Set_Field3 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field3); - - procedure Set_Field4 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field4); - - procedure Set_Field5 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field5); - - procedure Set_Field6 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field6); - - procedure Set_Field7 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field7); - - procedure Set_Field8 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field8); - - procedure Set_Field9 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field9); - - procedure Set_Field10 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field10); - - procedure Set_Field11 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field11); - - procedure Set_Field12 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field12); - - procedure Set_Field13 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field13); - - procedure Set_Field14 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field14); - - procedure Set_Field15 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field15); - - procedure Set_Field16 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field16); - - procedure Set_Field17 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field17); - - procedure Set_Field18 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field18); - - procedure Set_Field19 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field19); - - procedure Set_Field20 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field20); - - procedure Set_Field21 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field21); - - procedure Set_Field22 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field22); - - procedure Set_Field23 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field23); - - procedure Set_Field24 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field24); - - procedure Set_Field25 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field25); - - procedure Set_Field26 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field26); - - procedure Set_Field27 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field27); - - procedure Set_Field28 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field28); - - procedure Set_Field29 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field29); - - procedure Set_Field30 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field30); - - procedure Set_Field31 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field31); - - procedure Set_Field32 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field32); - - procedure Set_Field33 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field33); - - procedure Set_Field34 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field34); - - procedure Set_Field35 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field35); - - procedure Set_Field36 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field36); - - procedure Set_Field37 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field37); - - procedure Set_Field38 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field38); - - procedure Set_Field39 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field39); - - procedure Set_Field40 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field40); - - procedure Set_Field41 (N : Node_Id; Val : Union_Id); - pragma Inline (Set_Field41); - - procedure Set_Node1 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node1); - - procedure Set_Node2 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node2); - - procedure Set_Node3 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node3); - - procedure Set_Node4 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node4); - - procedure Set_Node5 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node5); - - procedure Set_Node6 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node6); - - procedure Set_Node7 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node7); - - procedure Set_Node8 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node8); - - procedure Set_Node9 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node9); - - procedure Set_Node10 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node10); - - procedure Set_Node11 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node11); - - procedure Set_Node12 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node12); - - procedure Set_Node13 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node13); - - procedure Set_Node14 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node14); - - procedure Set_Node15 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node15); - - procedure Set_Node16 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node16); - - procedure Set_Node17 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node17); - - procedure Set_Node18 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node18); - - procedure Set_Node19 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node19); - - procedure Set_Node20 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node20); - - procedure Set_Node21 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node21); - - procedure Set_Node22 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node22); - - procedure Set_Node23 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node23); - - procedure Set_Node24 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node24); - - procedure Set_Node25 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node25); - - procedure Set_Node26 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node26); - - procedure Set_Node27 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node27); - - procedure Set_Node28 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node28); - - procedure Set_Node29 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node29); - - procedure Set_Node30 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node30); - - procedure Set_Node31 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node31); - - procedure Set_Node32 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node32); - - procedure Set_Node33 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node33); - - procedure Set_Node34 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node34); - - procedure Set_Node35 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node35); - - procedure Set_Node36 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node36); - - procedure Set_Node37 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node37); - - procedure Set_Node38 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node38); - - procedure Set_Node39 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node39); - - procedure Set_Node40 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node40); - - procedure Set_Node41 (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node41); - - procedure Set_List1 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List1); - - procedure Set_List2 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List2); - - procedure Set_List3 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List3); - - procedure Set_List4 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List4); - - procedure Set_List5 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List5); - - procedure Set_List10 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List10); - - procedure Set_List14 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List14); - - procedure Set_List25 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List25); - - procedure Set_List38 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List38); - - procedure Set_List39 (N : Node_Id; Val : List_Id); - pragma Inline (Set_List39); - - procedure Set_Elist1 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist1); - - procedure Set_Elist2 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist2); - - procedure Set_Elist3 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist3); - - procedure Set_Elist4 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist4); - - procedure Set_Elist5 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist5); - - procedure Set_Elist8 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist8); - - procedure Set_Elist9 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist9); - - procedure Set_Elist10 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist10); - - procedure Set_Elist11 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist11); - - procedure Set_Elist13 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist13); - - procedure Set_Elist15 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist15); - - procedure Set_Elist16 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist16); - - procedure Set_Elist18 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist18); - - procedure Set_Elist21 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist21); - - procedure Set_Elist23 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist23); - - procedure Set_Elist24 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist24); - - procedure Set_Elist25 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist25); - - procedure Set_Elist26 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist26); - - procedure Set_Elist29 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist29); - - procedure Set_Elist30 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist30); - - procedure Set_Elist36 (N : Node_Id; Val : Elist_Id); - pragma Inline (Set_Elist36); - - procedure Set_Name1 (N : Node_Id; Val : Name_Id); - pragma Inline (Set_Name1); - - procedure Set_Name2 (N : Node_Id; Val : Name_Id); - pragma Inline (Set_Name2); - - procedure Set_Str3 (N : Node_Id; Val : String_Id); - pragma Inline (Set_Str3); - - procedure Set_Uint2 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint2); - - procedure Set_Uint3 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint3); - - procedure Set_Uint4 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint4); - - procedure Set_Uint5 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint5); - - procedure Set_Uint8 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint8); - - procedure Set_Uint9 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint9); - - procedure Set_Uint10 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint10); - - procedure Set_Uint11 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint11); - - procedure Set_Uint12 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint12); - - procedure Set_Uint13 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint13); - - procedure Set_Uint14 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint14); - - procedure Set_Uint15 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint15); - - procedure Set_Uint16 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint16); - - procedure Set_Uint17 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint17); - - procedure Set_Uint22 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint22); - - procedure Set_Uint24 (N : Node_Id; Val : Uint); - pragma Inline (Set_Uint24); - - procedure Set_Ureal3 (N : Node_Id; Val : Ureal); - pragma Inline (Set_Ureal3); - - procedure Set_Ureal18 (N : Node_Id; Val : Ureal); - pragma Inline (Set_Ureal18); - - procedure Set_Ureal21 (N : Node_Id; Val : Ureal); - pragma Inline (Set_Ureal21); - - procedure Set_Flag0 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag0); - - procedure Set_Flag1 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag1); - - procedure Set_Flag2 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag2); - - procedure Set_Flag3 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag3); - - procedure Set_Flag4 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag4); - - procedure Set_Flag5 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag5); - - procedure Set_Flag6 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag6); - - procedure Set_Flag7 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag7); - - procedure Set_Flag8 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag8); - - procedure Set_Flag9 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag9); - - procedure Set_Flag10 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag10); - - procedure Set_Flag11 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag11); - - procedure Set_Flag12 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag12); - - procedure Set_Flag13 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag13); - - procedure Set_Flag14 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag14); - - procedure Set_Flag15 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag15); - - procedure Set_Flag16 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag16); - - procedure Set_Flag17 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag17); - - procedure Set_Flag18 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag18); - - procedure Set_Flag19 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag19); - - procedure Set_Flag20 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag20); - - procedure Set_Flag21 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag21); - - procedure Set_Flag22 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag22); - - procedure Set_Flag23 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag23); - - procedure Set_Flag24 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag24); - - procedure Set_Flag25 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag25); - - procedure Set_Flag26 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag26); - - procedure Set_Flag27 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag27); - - procedure Set_Flag28 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag28); - - procedure Set_Flag29 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag29); - - procedure Set_Flag30 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag30); - - procedure Set_Flag31 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag31); - - procedure Set_Flag32 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag32); - - procedure Set_Flag33 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag33); - - procedure Set_Flag34 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag34); - - procedure Set_Flag35 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag35); - - procedure Set_Flag36 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag36); - - procedure Set_Flag37 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag37); - - procedure Set_Flag38 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag38); - - procedure Set_Flag39 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag39); - - procedure Set_Flag40 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag40); - - procedure Set_Flag41 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag41); - - procedure Set_Flag42 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag42); - - procedure Set_Flag43 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag43); - - procedure Set_Flag44 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag44); - - procedure Set_Flag45 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag45); - - procedure Set_Flag46 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag46); - - procedure Set_Flag47 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag47); - - procedure Set_Flag48 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag48); - - procedure Set_Flag49 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag49); - - procedure Set_Flag50 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag50); - - procedure Set_Flag51 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag51); - - procedure Set_Flag52 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag52); - - procedure Set_Flag53 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag53); - - procedure Set_Flag54 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag54); - - procedure Set_Flag55 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag55); - - procedure Set_Flag56 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag56); - - procedure Set_Flag57 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag57); - - procedure Set_Flag58 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag58); - - procedure Set_Flag59 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag59); - - procedure Set_Flag60 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag60); - - procedure Set_Flag61 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag61); - - procedure Set_Flag62 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag62); - - procedure Set_Flag63 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag63); - - procedure Set_Flag64 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag64); - - procedure Set_Flag65 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag65); - - procedure Set_Flag66 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag66); - - procedure Set_Flag67 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag67); - - procedure Set_Flag68 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag68); - - procedure Set_Flag69 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag69); - - procedure Set_Flag70 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag70); - - procedure Set_Flag71 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag71); - - procedure Set_Flag72 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag72); - - procedure Set_Flag73 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag73); - - procedure Set_Flag74 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag74); - - procedure Set_Flag75 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag75); - - procedure Set_Flag76 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag76); - - procedure Set_Flag77 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag77); - - procedure Set_Flag78 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag78); - - procedure Set_Flag79 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag79); - - procedure Set_Flag80 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag80); - - procedure Set_Flag81 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag81); - - procedure Set_Flag82 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag82); - - procedure Set_Flag83 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag83); - - procedure Set_Flag84 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag84); - - procedure Set_Flag85 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag85); - - procedure Set_Flag86 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag86); - - procedure Set_Flag87 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag87); - - procedure Set_Flag88 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag88); - - procedure Set_Flag89 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag89); - - procedure Set_Flag90 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag90); - - procedure Set_Flag91 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag91); - - procedure Set_Flag92 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag92); - - procedure Set_Flag93 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag93); - - procedure Set_Flag94 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag94); - - procedure Set_Flag95 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag95); - - procedure Set_Flag96 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag96); - - procedure Set_Flag97 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag97); - - procedure Set_Flag98 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag98); - - procedure Set_Flag99 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag99); - - procedure Set_Flag100 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag100); - - procedure Set_Flag101 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag101); - - procedure Set_Flag102 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag102); - - procedure Set_Flag103 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag103); - - procedure Set_Flag104 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag104); - - procedure Set_Flag105 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag105); - - procedure Set_Flag106 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag106); - - procedure Set_Flag107 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag107); - - procedure Set_Flag108 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag108); - - procedure Set_Flag109 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag109); - - procedure Set_Flag110 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag110); - - procedure Set_Flag111 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag111); - - procedure Set_Flag112 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag112); - - procedure Set_Flag113 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag113); - - procedure Set_Flag114 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag114); - - procedure Set_Flag115 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag115); - - procedure Set_Flag116 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag116); - - procedure Set_Flag117 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag117); - - procedure Set_Flag118 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag118); - - procedure Set_Flag119 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag119); - - procedure Set_Flag120 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag120); - - procedure Set_Flag121 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag121); - - procedure Set_Flag122 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag122); - - procedure Set_Flag123 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag123); - - procedure Set_Flag124 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag124); - - procedure Set_Flag125 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag125); - - procedure Set_Flag126 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag126); - - procedure Set_Flag127 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag127); - - procedure Set_Flag128 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag128); - - procedure Set_Flag129 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag129); - - procedure Set_Flag130 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag130); - - procedure Set_Flag131 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag131); - - procedure Set_Flag132 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag132); - - procedure Set_Flag133 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag133); - - procedure Set_Flag134 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag134); - - procedure Set_Flag135 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag135); - - procedure Set_Flag136 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag136); - - procedure Set_Flag137 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag137); - - procedure Set_Flag138 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag138); - - procedure Set_Flag139 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag139); - - procedure Set_Flag140 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag140); - - procedure Set_Flag141 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag141); - - procedure Set_Flag142 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag142); - - procedure Set_Flag143 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag143); - - procedure Set_Flag144 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag144); - - procedure Set_Flag145 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag145); - - procedure Set_Flag146 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag146); - - procedure Set_Flag147 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag147); - - procedure Set_Flag148 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag148); - - procedure Set_Flag149 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag149); - - procedure Set_Flag150 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag150); - - procedure Set_Flag151 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag151); - - procedure Set_Flag152 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag152); - - procedure Set_Flag153 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag153); - - procedure Set_Flag154 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag154); - - procedure Set_Flag155 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag155); - - procedure Set_Flag156 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag156); - - procedure Set_Flag157 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag157); - - procedure Set_Flag158 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag158); - - procedure Set_Flag159 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag159); - - procedure Set_Flag160 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag160); - - procedure Set_Flag161 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag161); - - procedure Set_Flag162 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag162); - - procedure Set_Flag163 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag163); - - procedure Set_Flag164 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag164); - - procedure Set_Flag165 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag165); - - procedure Set_Flag166 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag166); - - procedure Set_Flag167 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag167); - - procedure Set_Flag168 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag168); - - procedure Set_Flag169 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag169); - - procedure Set_Flag170 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag170); - - procedure Set_Flag171 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag171); - - procedure Set_Flag172 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag172); - - procedure Set_Flag173 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag173); - - procedure Set_Flag174 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag174); - - procedure Set_Flag175 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag175); - - procedure Set_Flag176 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag176); - - procedure Set_Flag177 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag177); - - procedure Set_Flag178 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag178); - - procedure Set_Flag179 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag179); - - procedure Set_Flag180 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag180); - - procedure Set_Flag181 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag181); - - procedure Set_Flag182 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag182); - - procedure Set_Flag183 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag183); - - procedure Set_Flag184 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag184); - - procedure Set_Flag185 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag185); - - procedure Set_Flag186 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag186); - - procedure Set_Flag187 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag187); - - procedure Set_Flag188 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag188); - - procedure Set_Flag189 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag189); - - procedure Set_Flag190 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag190); - - procedure Set_Flag191 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag191); - - procedure Set_Flag192 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag192); - - procedure Set_Flag193 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag193); - - procedure Set_Flag194 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag194); - - procedure Set_Flag195 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag195); - - procedure Set_Flag196 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag196); - - procedure Set_Flag197 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag197); - - procedure Set_Flag198 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag198); - - procedure Set_Flag199 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag199); - - procedure Set_Flag200 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag200); - - procedure Set_Flag201 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag201); - - procedure Set_Flag202 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag202); - - procedure Set_Flag203 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag203); - - procedure Set_Flag204 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag204); - - procedure Set_Flag205 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag205); - - procedure Set_Flag206 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag206); - - procedure Set_Flag207 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag207); - - procedure Set_Flag208 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag208); - - procedure Set_Flag209 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag209); - - procedure Set_Flag210 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag210); - - procedure Set_Flag211 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag211); - - procedure Set_Flag212 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag212); - - procedure Set_Flag213 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag213); - - procedure Set_Flag214 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag214); - - procedure Set_Flag215 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag215); - - procedure Set_Flag216 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag216); - - procedure Set_Flag217 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag217); - - procedure Set_Flag218 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag218); - - procedure Set_Flag219 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag219); - - procedure Set_Flag220 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag220); - - procedure Set_Flag221 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag221); - - procedure Set_Flag222 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag222); - - procedure Set_Flag223 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag223); - - procedure Set_Flag224 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag224); - - procedure Set_Flag225 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag225); - - procedure Set_Flag226 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag226); - - procedure Set_Flag227 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag227); - - procedure Set_Flag228 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag228); - - procedure Set_Flag229 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag229); - - procedure Set_Flag230 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag230); - - procedure Set_Flag231 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag231); - - procedure Set_Flag232 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag232); - - procedure Set_Flag233 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag233); - - procedure Set_Flag234 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag234); - - procedure Set_Flag235 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag235); - - procedure Set_Flag236 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag236); - - procedure Set_Flag237 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag237); - - procedure Set_Flag238 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag238); - - procedure Set_Flag239 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag239); - - procedure Set_Flag240 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag240); - - procedure Set_Flag241 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag241); - - procedure Set_Flag242 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag242); - - procedure Set_Flag243 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag243); - - procedure Set_Flag244 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag244); - - procedure Set_Flag245 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag245); - - procedure Set_Flag246 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag246); - - procedure Set_Flag247 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag247); - - procedure Set_Flag248 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag248); - - procedure Set_Flag249 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag249); - - procedure Set_Flag250 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag250); - - procedure Set_Flag251 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag251); - - procedure Set_Flag252 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag252); - - procedure Set_Flag253 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag253); - - procedure Set_Flag254 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag254); - - procedure Set_Flag255 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag255); - - procedure Set_Flag256 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag256); - - procedure Set_Flag257 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag257); - - procedure Set_Flag258 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag258); - - procedure Set_Flag259 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag259); - - procedure Set_Flag260 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag260); - - procedure Set_Flag261 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag261); - - procedure Set_Flag262 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag262); - - procedure Set_Flag263 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag263); - - procedure Set_Flag264 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag264); - - procedure Set_Flag265 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag265); - - procedure Set_Flag266 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag266); - - procedure Set_Flag267 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag267); - - procedure Set_Flag268 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag268); - - procedure Set_Flag269 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag269); - - procedure Set_Flag270 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag270); - - procedure Set_Flag271 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag271); - - procedure Set_Flag272 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag272); - - procedure Set_Flag273 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag273); - - procedure Set_Flag274 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag274); - - procedure Set_Flag275 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag275); - - procedure Set_Flag276 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag276); - - procedure Set_Flag277 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag277); - - procedure Set_Flag278 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag278); - - procedure Set_Flag279 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag279); - - procedure Set_Flag280 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag280); - - procedure Set_Flag281 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag281); - - procedure Set_Flag282 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag282); - - procedure Set_Flag283 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag283); - - procedure Set_Flag284 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag284); - - procedure Set_Flag285 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag285); - - procedure Set_Flag286 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag286); - - procedure Set_Flag287 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag287); - - procedure Set_Flag288 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag288); - - procedure Set_Flag289 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag289); - - procedure Set_Flag290 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag290); - - procedure Set_Flag291 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag291); - - procedure Set_Flag292 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag292); - - procedure Set_Flag293 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag293); - - procedure Set_Flag294 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag294); - - procedure Set_Flag295 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag295); - - procedure Set_Flag296 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag296); - - procedure Set_Flag297 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag297); - - procedure Set_Flag298 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag298); - - procedure Set_Flag299 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag299); - - procedure Set_Flag300 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag300); - - procedure Set_Flag301 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag301); - - procedure Set_Flag302 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag302); - - procedure Set_Flag303 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag303); - - procedure Set_Flag304 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag304); - - procedure Set_Flag305 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag305); - - procedure Set_Flag306 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag306); - - procedure Set_Flag307 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag307); - - procedure Set_Flag308 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag308); - - procedure Set_Flag309 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag309); - - procedure Set_Flag310 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag310); - - procedure Set_Flag311 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag311); - - procedure Set_Flag312 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag312); - - procedure Set_Flag313 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag313); - - procedure Set_Flag314 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag314); - - procedure Set_Flag315 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag315); - - procedure Set_Flag316 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag316); - - procedure Set_Flag317 (N : Node_Id; Val : Boolean); - pragma Inline (Set_Flag317); - - -- The following versions of Set_Noden also set the parent pointer of - -- the referenced node if it is not Empty. - - procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node1_With_Parent); - - procedure Set_Node2_With_Parent (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node2_With_Parent); - - procedure Set_Node3_With_Parent (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node3_With_Parent); - - procedure Set_Node4_With_Parent (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node4_With_Parent); - - procedure Set_Node5_With_Parent (N : Node_Id; Val : Node_Id); - pragma Inline (Set_Node5_With_Parent); - - -- The following versions of Set_Listn also set the parent pointer of - -- the referenced node if it is not Empty. - - procedure Set_List1_With_Parent (N : Node_Id; Val : List_Id); - pragma Inline (Set_List1_With_Parent); - - procedure Set_List2_With_Parent (N : Node_Id; Val : List_Id); - pragma Inline (Set_List2_With_Parent); - - procedure Set_List3_With_Parent (N : Node_Id; Val : List_Id); - pragma Inline (Set_List3_With_Parent); - - procedure Set_List4_With_Parent (N : Node_Id; Val : List_Id); - pragma Inline (Set_List4_With_Parent); - - procedure Set_List5_With_Parent (N : Node_Id; Val : List_Id); - pragma Inline (Set_List5_With_Parent); - - end Unchecked_Access; + type Node_Field_Set is array (Node_Field) of Boolean with Pack; + + type Entity_Field_Set is array (Entity_Field) of Boolean with Pack; + + procedure Reinit_Field_To_Zero (N : Node_Id; Field : Node_Field); + procedure Reinit_Field_To_Zero (N : Node_Id; Field : Entity_Field); + -- When a node is created, all fields are initialized to zero, even if zero + -- is not a valid value of the field type. These procedures put the field + -- back to its initial zero value. Note that you can't just do something + -- like Set_Some_Field (N, 0), if Some_Field is of (say) type Uintp, + -- because Uintp is a subrange that does not include 0. + type Entity_Kind_Set is array (Entity_Kind) of Boolean with Pack; + procedure Reinit_Field_To_Zero + (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind_Set); + procedure Reinit_Field_To_Zero + (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind); + -- Same as above, but assert that the old Ekind is as specified. We might + -- want to get rid of these, but it's useful documentation while working on + -- this. + + function Field_Is_Initial_Zero + (N : Node_Id; Field : Node_Field) return Boolean; + function Field_Is_Initial_Zero + (N : Entity_Id; Field : Entity_Field) return Boolean; + -- True if the field value is the initial zero value + + procedure Mutate_Nkind + (N : Node_Id; Val : Node_Kind) with Inline; + -- There is no Set_Nkind in Sinfo.Nodes. We use this instead. This is here, + -- and has a different name, because it does some extra checking. Nkind is + -- like a discriminant, in that it controls which fields exist, and that + -- set of fields can be different for the new kind. Discriminants cannot be + -- modified in Ada for that reason. The rule here is more flexible: Nkind + -- can be modified. However, when Nkind is modified, fields that exist for + -- the old kind, but not for the new kind will vanish. We require that all + -- vanishing fields be set to their initial zero value before calling + -- Mutate_Nkind. This is necessary, because the memory occupied by the + -- vanishing fields might be used for totally unrelated fields in the new + -- node. See Reinit_Field_To_Zero. + + procedure Set_Ekind + (N : Entity_Id; Val : Entity_Kind) with Inline; + -- ????Perhaps should be called Mutate_Ekind. + -- + -- Ekind is also like a discriminant, and is mostly treated as above (see + -- Mutate_Nkind). However, there are a few cases where we set the Ekind + -- from its initial E_Void value to something else, then set it back to + -- E_Void, then back to the something else, and we expect the "something + -- else" fields to retain their value. Two two "something else"s are not + -- always the same; for example we change from E_Void, to E_Variable, to + -- E_Void, to E_Constant. ????This needs to be fixed. + + procedure Print_Atree_Info (N : Node_Or_Entity_Id); + -- Called from Treepr to print out information about N that is private to + -- Atree. ----------------------------- -- Private Part Subpackage -- @@ -3650,347 +688,237 @@ package Atree is package Atree_Private_Part is + pragma Assert (Node_Kind'Pos (N_Unused_At_Start) = 0); + pragma Assert (Empty_List_Or_Node = 0); + pragma Assert (Entity_Kind'Pos (E_Void) = 0); + -- We want nodes initialized to zero bits by default + ------------------------- -- Tree Representation -- ------------------------- - -- The nodes of the tree are stored in a table (i.e. an array). In the - -- case of extended nodes six consecutive components in the array are - -- used. There are thus two formats for array components. One is used - -- for nonextended nodes, and for the first component of extended - -- nodes. The other is used for the extension parts (second, third, - -- fourth, fifth, and sixth components) of an extended node. A variant - -- record structure is used to distinguish the two formats. - - type Node_Record (Is_Extension : Boolean := False) is record - - -- Logically, the only field in the common part is the above - -- Is_Extension discriminant (a single bit). However, Gigi cannot - -- yet handle such a structure, so we fill out the common part of - -- the record with fields that are used in different ways for - -- normal nodes and node extensions. - - Pflag1, Pflag2 : Boolean; - -- The Paren_Count field is represented using two boolean flags, - -- where Pflag1 is worth 1, and Pflag2 is worth 2. This is done - -- because we need to be easily able to reuse this field for - -- extra flags in the extended node case. - - In_List : Boolean; - -- Flag used to indicate if node is a member of a list. - -- This field is considered private to the Atree package. - - Has_Aspects : Boolean; - -- Flag used to indicate that a node has aspect specifications that - -- are associated with the node. See Aspects package for details. - - Rewrite_Ins : Boolean; - -- Flag set by Mark_Rewrite_Insertion procedure. - -- This field is considered private to the Atree package. - - Analyzed : Boolean; - -- Flag to indicate the node has been analyzed (and expanded) - - Comes_From_Source : Boolean; - -- Flag to indicate that node comes from the source program (i.e. - -- was built by the parser or scanner, not the analyzer or expander). - - Error_Posted : Boolean; - -- Flag to indicate that an error message has been posted on the - -- node (to avoid duplicate flags on the same node) - - Flag4 : Boolean; - Flag5 : Boolean; - Flag6 : Boolean; - Flag7 : Boolean; - Flag8 : Boolean; - Flag9 : Boolean; - Flag10 : Boolean; - Flag11 : Boolean; - Flag12 : Boolean; - Flag13 : Boolean; - Flag14 : Boolean; - Flag15 : Boolean; - Flag16 : Boolean; - Flag17 : Boolean; - Flag18 : Boolean; - -- Flags 4-18 for a normal node. Note that Flags 0-3 are stored - -- separately in the Flags array. - - -- The above fields are used as follows in components 2-6 of an - -- extended node entry. Currently they are not used in component 7, - -- since for now we have all the flags we need, but of course they - -- can be used for additional flags when needed in component 7. - - -- In_List used as Flag19,Flag40,Flag129,Flag216,Flag287 - -- Has_Aspects used as Flag20,Flag41,Flag130,Flag217,Flag288 - -- Rewrite_Ins used as Flag21,Flag42,Flag131,Flag218,Flag289 - -- Analyzed used as Flag22,Flag43,Flag132,Flag219,Flag290 - -- Comes_From_Source used as Flag23,Flag44,Flag133,Flag220,Flag291 - -- Error_Posted used as Flag24,Flag45,Flag134,Flag221,Flag292 - -- Flag4 used as Flag25,Flag46,Flag135,Flag222,Flag293 - -- Flag5 used as Flag26,Flag47,Flag136,Flag223,Flag294 - -- Flag6 used as Flag27,Flag48,Flag137,Flag224,Flag295 - -- Flag7 used as Flag28,Flag49,Flag138,Flag225,Flag296 - -- Flag8 used as Flag29,Flag50,Flag139,Flag226,Flag297 - -- Flag9 used as Flag30,Flag51,Flag140,Flag227,Flag298 - -- Flag10 used as Flag31,Flag52,Flag141,Flag228,Flag299 - -- Flag11 used as Flag32,Flag53,Flag142,Flag229,Flag300 - -- Flag12 used as Flag33,Flag54,Flag143,Flag230,Flag301 - -- Flag13 used as Flag34,Flag55,Flag144,Flag231,Flag302 - -- Flag14 used as Flag35,Flag56,Flag145,Flag232,Flag303 - -- Flag15 used as Flag36,Flag57,Flag146,Flag233,Flag304 - -- Flag16 used as Flag37,Flag58,Flag147,Flag234,Flag305 - -- Flag17 used as Flag38,Flag59,Flag148,Flag235,Flag306 - -- Flag18 used as Flag39,Flag60,Flag149,Flag236,Flag307 - -- Pflag1 used as Flag61,Flag62,Flag150,Flag237,Flag308 - -- Pflag2 used as Flag63,Flag64,Flag151,Flag238,Flag309 - - Nkind : Node_Kind; - -- For a nonextended node, or the initial section of an extended - -- node, this field holds the Node_Kind value. For an extended node, - -- The Nkind field is used as follows: - -- - -- Second entry: holds the Ekind field of the entity - -- Third entry: holds 8 additional flags (Flag65-Flag72) - -- Fourth entry: holds 8 additional flags (Flag239-246) - -- Fifth entry: holds 8 additional flags (Flag247-254) - -- Sixth entry: holds 8 additional flags (Flag310-317) - -- Seventh entry: currently unused - - -- Now finally (on a 32-bit boundary) comes the variant part - - case Is_Extension is - - -- Nonextended node, or first component of extended node - - when False => - - Sloc : Source_Ptr; - -- Source location for this node - - Link : Union_Id; - -- This field is used either as the Parent pointer (if In_List - -- is False), or to point to the list header (if In_List is - -- True). This field is considered private and can be modified - -- only by Atree or by Nlists. - - Field1 : Union_Id; - Field2 : Union_Id; - Field3 : Union_Id; - Field4 : Union_Id; - Field5 : Union_Id; - -- Five general use fields, which can contain Node_Id, List_Id, - -- Elist_Id, String_Id, or Name_Id values depending on the - -- values in Nkind and (for extended nodes), in Ekind. See - -- packages Sinfo and Einfo for details of their use. - - -- Extension (second component) of extended node - - when True => - - Field6 : Union_Id; - Field7 : Union_Id; - Field8 : Union_Id; - Field9 : Union_Id; - Field10 : Union_Id; - Field11 : Union_Id; - Field12 : Union_Id; - -- Seven additional general fields available only for entities. - -- See package Einfo for details of their use (which depends - -- on the value in the Ekind field). - - -- In the third component, the extension format as described - -- above is used to hold additional general fields and flags - -- as follows: - - -- Field6-11 Holds Field13-Field18 - -- Field12 Holds Flag73-Flag96 and Convention - - -- In the fourth component, the extension format as described - -- above is used to hold additional general fields and flags - -- as follows: - - -- Field6-10 Holds Field19-Field23 - -- Field11 Holds Flag152-Flag183 - -- Field12 Holds Flag97-Flag128 - - -- In the fifth component, the extension format as described - -- above is used to hold additional general fields and flags - -- as follows: - - -- Field6-11 Holds Field24-Field29 - -- Field12 Holds Flag184-Flag215 - - -- In the sixth component, the extension format as described - -- above is used to hold additional general fields and flags - -- as follows: - - -- Field6-11 Holds Field30-Field35 - -- Field12 Holds Flag255-Flag286 - - -- In the seventh component, the extension format as described - -- above is used to hold additional general fields as follows. - -- Flags are also available potentially, but not used now, as - -- we are not short of entity flags. - - -- Field6-11 Holds Field36-Field41 - - end case; - end record; -- Node_Record - pragma Suppress_Initialization (Node_Record); -- see package Nodes below - - pragma Pack (Node_Record); - for Node_Record'Size use 8 * 32; - for Node_Record'Alignment use 4; - - function E_To_N is new Unchecked_Conversion (Entity_Kind, Node_Kind); - function N_To_E is new Unchecked_Conversion (Node_Kind, Entity_Kind); - - -- Default value used to initialize default nodes. Note that some of the - -- fields get overwritten, and in particular, Nkind always gets reset. - - Default_Node : constant Node_Record := ( - Is_Extension => False, - Pflag1 => False, - Pflag2 => False, - In_List => False, - Has_Aspects => False, - Rewrite_Ins => False, - Analyzed => False, - Comes_From_Source => False, - Error_Posted => False, - Flag4 => False, - - Flag5 => False, - Flag6 => False, - Flag7 => False, - Flag8 => False, - Flag9 => False, - Flag10 => False, - Flag11 => False, - Flag12 => False, - - Flag13 => False, - Flag14 => False, - Flag15 => False, - Flag16 => False, - Flag17 => False, - Flag18 => False, - - Nkind => N_Unused_At_Start, - - Sloc => 0, - Link => Empty_List_Or_Node, - Field1 => Empty_List_Or_Node, - Field2 => Empty_List_Or_Node, - Field3 => Empty_List_Or_Node, - Field4 => Empty_List_Or_Node, - Field5 => Empty_List_Or_Node); - - -- Default value used to initialize node extensions (i.e. the second - -- through seventh components of an extended node). Note we are cheating - -- a bit here when it comes to Node12, which often holds flags and (for - -- the third component), the convention. But it works because Empty, - -- False, Convention_Ada, all happen to be all zero bits. - - Default_Node_Extension : constant Node_Record := ( - Is_Extension => True, - Pflag1 => False, - Pflag2 => False, - In_List => False, - Has_Aspects => False, - Rewrite_Ins => False, - Analyzed => False, - Comes_From_Source => False, - Error_Posted => False, - Flag4 => False, - - Flag5 => False, - Flag6 => False, - Flag7 => False, - Flag8 => False, - Flag9 => False, - Flag10 => False, - Flag11 => False, - Flag12 => False, - - Flag13 => False, - Flag14 => False, - Flag15 => False, - Flag16 => False, - Flag17 => False, - Flag18 => False, - - Nkind => E_To_N (E_Void), - - Field6 => Empty_List_Or_Node, - Field7 => Empty_List_Or_Node, - Field8 => Empty_List_Or_Node, - Field9 => Empty_List_Or_Node, - Field10 => Empty_List_Or_Node, - Field11 => Empty_List_Or_Node, - Field12 => Empty_List_Or_Node); - - -- The following defines the extendable array used for the nodes table. - -- Nodes with extensions use multiple consecutive entries in the array - -- (see Num_Extension_Nodes). - - package Nodes is new Table.Table - (Table_Component_Type => Node_Record, + -- The nodes of the tree are stored in two tables (i.e. growable + -- arrays). + + -- A Node_Id points to an element of Nodes, which contains a + -- Field_Offset that points to an element of Slots. Each slot can + -- contain a single 32-bit field, or multiple smaller fields. + -- An n-bit field is aligned on an n-bit boundary. The size of a node is + -- the number of slots, which can range from 1 up to however many are + -- needed. + -- + -- The reason for the extra level of indirection is that Copy_Node, + -- Exchange_Entities, and Rewrite all assume that nodes can be modified + -- in place. + + subtype Node_Offset is Field_Offset'Base + range 1 .. Field_Offset'Base'Last; + + package Node_Offsets is new Table.Table + (Table_Component_Type => Node_Offset, Table_Index_Type => Node_Id'Base, Table_Low_Bound => First_Node_Id, - Table_Initial => Alloc.Nodes_Initial, - Table_Increment => Alloc.Nodes_Increment, - Release_Threshold => Alloc.Nodes_Release_Threshold, - Table_Name => "Nodes"); - - -- The following is a parallel table to Nodes, which provides 8 more - -- bits of space that logically belong to the corresponding node. This - -- is currently used to implement Flags 0,1,2,3 for normal nodes, or - -- the first component of an extended node (four bits unused). Entries - -- for extending components are completely unused. - - type Flags_Byte is record - Flag0 : Boolean; - -- Note: we don't use Flag0 at the moment. To put Flag0 into use - -- requires some awkward work in Treeprs (treeprs.adt), so for the - -- moment we don't use it. - - Flag1 : Boolean; - Flag2 : Boolean; - Flag3 : Boolean; - -- These flags are used in the usual manner in Sinfo and Einfo - - -- The flags listed below use explicit names because following the - -- FlagXXX convention would mean reshuffling of over 300+ flags. - - Check_Actuals : Boolean; - -- Flag set to indicate that the marked node is subject to the check - -- for writable actuals. - - Is_Ignored_Ghost_Node : Boolean; - -- Flag denoting whether the node is subject to pragma Ghost with - -- policy Ignore. - - Spare2 : Boolean; - Spare3 : Boolean; - end record; - - for Flags_Byte'Size use 8; - pragma Pack (Flags_Byte); - - Default_Flags : constant Flags_Byte := (others => False); - -- Default value used to initialize new entries - - package Flags is new Table.Table ( - Table_Component_Type => Flags_Byte, - Table_Index_Type => Node_Id'Base, - Table_Low_Bound => First_Node_Id, - Table_Initial => Alloc.Nodes_Initial, - Table_Increment => Alloc.Nodes_Increment, - Release_Threshold => Alloc.Nodes_Release_Threshold, - Table_Name => "Flags"); + Table_Initial => Alloc.Node_Offsets_Initial, + Table_Increment => Alloc.Node_Offsets_Increment, + Table_Name => "Node_Offsets"); + + -- We define type Slot as a packed Unchecked_Union of slots with + -- appropriate numbers of components of appropriate size. The reason + -- for this (as opposed to using packed arrays) is that we are using + -- bit fields on the C++ side, and C++ doesn't have packed arrays. + + type Field_1_Bit is mod 2**1; + type Slot_1_Bit is record -- 32 1-bit fields + F0, F1, F2, F3, F4, F5, F6, F7, F8, F9, + F10, F11, F12, F13, F14, F15, F16, F17, F18, F19, + F20, F21, F22, F23, F24, F25, F26, F27, F28, F29, + F30, F31 : + Field_1_Bit; + end record with Pack, Convention => C; + pragma Assert (Slot_1_Bit'Size = 32); + + type Field_2_Bit is mod 2**2; + type Slot_2_Bit is record -- 16 2-bit fields + F0, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15 : + Field_2_Bit; + end record with Pack, Convention => C; + pragma Assert (Slot_2_Bit'Size = 32); + + type Field_4_Bit is mod 2**4; + type Slot_4_Bit is record -- 8 4-bit fields + F0, F1, F2, F3, F4, F5, F6, F7 : + Field_4_Bit; + end record with Pack, Convention => C; + pragma Assert (Slot_4_Bit'Size = 32); + + type Field_8_Bit is mod 2**8; + type Slot_8_Bit is record -- 4 8-bit fields + F0, F1, F2, F3 : + Field_8_Bit; + end record with Pack, Convention => C; + pragma Assert (Slot_8_Bit'Size = 32); + + type Field_32_Bit is mod 2**32; + subtype Slot_32_Bit is Field_32_Bit; -- 1 32-bit field + pragma Assert (Slot_32_Bit'Size = 32); + + type Slot (Field_Size : Field_Size_In_Bits := 9999) is record + case Field_Size is + when 1 => Slot_1 : Slot_1_Bit; + when 2 => Slot_2 : Slot_2_Bit; + when 4 => Slot_4 : Slot_4_Bit; + when 8 => Slot_8 : Slot_8_Bit; + when 32 => Slot_32 : Slot_32_Bit; + when others => null; + end case; + end record with Unchecked_Union; + pragma Assert (Slot'Size = 32); + + Slots_Low_Bound : constant Field_Offset := Field_Offset'First + 1; + + package Slots is new Table.Table + (Table_Component_Type => Slot, + Table_Index_Type => Node_Offset'Base, + Table_Low_Bound => Slots_Low_Bound, + Table_Initial => Alloc.Slots_Initial, + Table_Increment => Alloc.Slots_Increment, + Table_Name => "Slots"); + -- Note that Table_Low_Bound is set such that if we try to access + -- Slots.Table (0), we will get Constraint_Error. + + Noff : Node_Offsets.Table_Ptr renames Node_Offsets.Table; + function Nlast return Node_Id'Base renames Node_Offsets.Last; + Lots : Slots.Table_Ptr renames Slots.Table; + function Slast return Node_Offset'Base renames Slots.Last; + -- Work around limitations of gdb; it can't find Node_Offsets.Table, + -- etc, without a full expanded name. + + function Alloc_Node_Id return Node_Id with Inline; + + function Alloc_Slots (Num_Slots : Field_Offset) return Node_Offset + with Inline; + + -- Each of the following Get_N_Bit_Field functions fetches the field of + -- the given Field_Type at the given offset. Field_Type'Size must be N. + -- The offset is measured in units of Field_Type'Size. Likewise for the + -- Set_N_Bit_Field procedures. + + generic + type Field_Type is private; + function Get_1_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + with Inline; + + generic + type Field_Type is private; + function Get_2_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + with Inline; + + generic + type Field_Type is private; + function Get_4_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + with Inline; + + generic + type Field_Type is private; + function Get_8_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + with Inline; + + generic + type Field_Type is private; + function Get_32_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + with Inline; + + generic + type Field_Type is private; + Default_Val : Field_Type; + function Get_32_Bit_Field_With_Default + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type + with Inline; + -- If the field has not yet been set, return Default_Val + + generic + type Field_Type is private; + procedure Set_1_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + with Inline; + + generic + type Field_Type is private; + procedure Set_2_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + with Inline; + + generic + type Field_Type is private; + procedure Set_4_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + with Inline; + + generic + type Field_Type is private; + procedure Set_8_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + with Inline; + + generic + type Field_Type is private; + procedure Set_32_Bit_Field + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type) + with Inline; + + -- The following are similar to the above generics, but are not generic, + -- and work with the low-level Field_n_bit types. If generics could be + -- overloaded, we would use the same names. + + function Get_1_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_1_Bit + with Inline; + + function Get_2_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_2_Bit + with Inline; + + function Get_4_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_4_Bit + with Inline; + + function Get_8_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_8_Bit + with Inline; + + function Get_32_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_32_Bit + with Inline; + + procedure Set_1_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_1_Bit) + with Inline; + + procedure Set_2_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_2_Bit) + with Inline; + + procedure Set_4_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_4_Bit) + with Inline; + + procedure Set_8_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_8_Bit) + with Inline; + + procedure Set_32_Bit_Val + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_32_Bit) + with Inline; + + procedure Validate_Node (N : Node_Or_Entity_Id); + procedure Validate_Node_Write (N : Node_Or_Entity_Id); + + function Is_Valid_Node (U : Union_Id) return Boolean; end Atree_Private_Part; diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index 2c886970999..6b8f7b9c50d 100644 --- a/gcc/ada/atree.h +++ b/gcc/ada/atree.h @@ -35,353 +35,12 @@ extern "C" { #endif -/* Structure used for the first part of the node in the case where we have - an Nkind. */ - -struct NFK -{ - Boolean is_extension : 1; - Boolean pflag1 : 1; - Boolean pflag2 : 1; - Boolean in_list : 1; - Boolean has_aspects : 1; - Boolean rewrite_ins : 1; - Boolean analyzed : 1; - Boolean c_f_s : 1; - Boolean error_posted : 1; - - Boolean flag4 : 1; - Boolean flag5 : 1; - Boolean flag6 : 1; - Boolean flag7 : 1; - Boolean flag8 : 1; - Boolean flag9 : 1; - Boolean flag10 : 1; - - Boolean flag11 : 1; - Boolean flag12 : 1; - Boolean flag13 : 1; - Boolean flag14 : 1; - Boolean flag15 : 1; - Boolean flag16 : 1; - Boolean flag17 : 1; - Boolean flag18 : 1; - - unsigned char kind; -}; - -/* Structure for the first part of a node when Nkind is not present by - extra flag bits are. */ - -struct NFNK -{ - Boolean is_extension : 1; - Boolean pflag1 : 1; - Boolean pflag2 : 1; - Boolean in_list : 1; - Boolean has_aspects : 1; - Boolean rewrite_ins : 1; - Boolean analyzed : 1; - Boolean c_f_s : 1; - Boolean error_posted : 1; - - Boolean flag4 : 1; - Boolean flag5 : 1; - Boolean flag6 : 1; - Boolean flag7 : 1; - Boolean flag8 : 1; - Boolean flag9 : 1; - Boolean flag10 : 1; - - Boolean flag11 : 1; - Boolean flag12 : 1; - Boolean flag13 : 1; - Boolean flag14 : 1; - Boolean flag15 : 1; - Boolean flag16 : 1; - Boolean flag17 : 1; - Boolean flag18 : 1; - - Boolean flag65 : 1; - Boolean flag66 : 1; - Boolean flag67 : 1; - Boolean flag68 : 1; - Boolean flag69 : 1; - Boolean flag70 : 1; - Boolean flag71 : 1; - Boolean flag72 : 1; -}; - -/* Structure used for extra flags in third component overlaying Field12 */ -struct Flag_Word -{ - Boolean flag73 : 1; - Boolean flag74 : 1; - Boolean flag75 : 1; - Boolean flag76 : 1; - Boolean flag77 : 1; - Boolean flag78 : 1; - Boolean flag79 : 1; - Boolean flag80 : 1; - Boolean flag81 : 1; - Boolean flag82 : 1; - Boolean flag83 : 1; - Boolean flag84 : 1; - Boolean flag85 : 1; - Boolean flag86 : 1; - Boolean flag87 : 1; - Boolean flag88 : 1; - Boolean flag89 : 1; - Boolean flag90 : 1; - Boolean flag91 : 1; - Boolean flag92 : 1; - Boolean flag93 : 1; - Boolean flag94 : 1; - Boolean flag95 : 1; - Boolean flag96 : 1; - Byte convention : 8; -}; - -/* Structure used for extra flags in fourth component overlaying Field12 */ -struct Flag_Word2 -{ - Boolean flag97 : 1; - Boolean flag98 : 1; - Boolean flag99 : 1; - Boolean flag100 : 1; - Boolean flag101 : 1; - Boolean flag102 : 1; - Boolean flag103 : 1; - Boolean flag104 : 1; - Boolean flag105 : 1; - Boolean flag106 : 1; - Boolean flag107 : 1; - Boolean flag108 : 1; - Boolean flag109 : 1; - Boolean flag110 : 1; - Boolean flag111 : 1; - Boolean flag112 : 1; - Boolean flag113 : 1; - Boolean flag114 : 1; - Boolean flag115 : 1; - Boolean flag116 : 1; - Boolean flag117 : 1; - Boolean flag118 : 1; - Boolean flag119 : 1; - Boolean flag120 : 1; - Boolean flag121 : 1; - Boolean flag122 : 1; - Boolean flag123 : 1; - Boolean flag124 : 1; - Boolean flag125 : 1; - Boolean flag126 : 1; - Boolean flag127 : 1; - Boolean flag128 : 1; -}; - -/* Structure used for extra flags in fourth component overlaying Field11 */ -struct Flag_Word3 -{ - Boolean flag152 : 1; - Boolean flag153 : 1; - Boolean flag154 : 1; - Boolean flag155 : 1; - Boolean flag156 : 1; - Boolean flag157 : 1; - Boolean flag158 : 1; - Boolean flag159 : 1; - - Boolean flag160 : 1; - Boolean flag161 : 1; - Boolean flag162 : 1; - Boolean flag163 : 1; - Boolean flag164 : 1; - Boolean flag165 : 1; - Boolean flag166 : 1; - Boolean flag167 : 1; - - Boolean flag168 : 1; - Boolean flag169 : 1; - Boolean flag170 : 1; - Boolean flag171 : 1; - Boolean flag172 : 1; - Boolean flag173 : 1; - Boolean flag174 : 1; - Boolean flag175 : 1; - - Boolean flag176 : 1; - Boolean flag177 : 1; - Boolean flag178 : 1; - Boolean flag179 : 1; - Boolean flag180 : 1; - Boolean flag181 : 1; - Boolean flag182 : 1; - Boolean flag183 : 1; -}; - -/* Structure used for extra flags in fifth component overlaying Field12 */ -struct Flag_Word4 -{ - Boolean flag184 : 1; - Boolean flag185 : 1; - Boolean flag186 : 1; - Boolean flag187 : 1; - Boolean flag188 : 1; - Boolean flag189 : 1; - Boolean flag190 : 1; - Boolean flag191 : 1; - - Boolean flag192 : 1; - Boolean flag193 : 1; - Boolean flag194 : 1; - Boolean flag195 : 1; - Boolean flag196 : 1; - Boolean flag197 : 1; - Boolean flag198 : 1; - Boolean flag199 : 1; - - Boolean flag200 : 1; - Boolean flag201 : 1; - Boolean flag202 : 1; - Boolean flag203 : 1; - Boolean flag204 : 1; - Boolean flag205 : 1; - Boolean flag206 : 1; - Boolean flag207 : 1; - - Boolean flag208 : 1; - Boolean flag209 : 1; - Boolean flag210 : 1; - Boolean flag211 : 1; - Boolean flag212 : 1; - Boolean flag213 : 1; - Boolean flag214 : 1; - Boolean flag215 : 1; -}; - -/* Structure used for extra flags in sixth component overlaying Field12 */ -struct Flag_Word5 -{ - Boolean flag255 : 1; - Boolean flag256 : 1; - Boolean flag257 : 1; - Boolean flag258 : 1; - Boolean flag259 : 1; - Boolean flag260 : 1; - Boolean flag261 : 1; - Boolean flag262 : 1; - - Boolean flag263 : 1; - Boolean flag264 : 1; - Boolean flag265 : 1; - Boolean flag266 : 1; - Boolean flag267 : 1; - Boolean flag268 : 1; - Boolean flag269 : 1; - Boolean flag270 : 1; - - Boolean flag271 : 1; - Boolean flag272 : 1; - Boolean flag273 : 1; - Boolean flag274 : 1; - Boolean flag275 : 1; - Boolean flag276 : 1; - Boolean flag277 : 1; - Boolean flag278 : 1; - - Boolean flag279 : 1; - Boolean flag280 : 1; - Boolean flag281 : 1; - Boolean flag282 : 1; - Boolean flag283 : 1; - Boolean flag284 : 1; - Boolean flag285 : 1; - Boolean flag286 : 1; -}; -struct Non_Extended -{ - Source_Ptr sloc; - Int link; - Int field1; - Int field2; - Int field3; - Int field4; - Int field5; -}; - -/* The Following structure corresponds to variant with is_extension = True. */ -struct Extended -{ - Int field6; - Int field7; - Int field8; - Int field9; - Int field10; - union - { - Int field11; - struct Flag_Word3 fw3; - } X; - - union - { - Int field12; - struct Flag_Word fw; - struct Flag_Word2 fw2; - struct Flag_Word4 fw4; - struct Flag_Word5 fw5; - } U; -}; - -/* A tree node itself. */ - -struct Node -{ - union kind - { - struct NFK K; - struct NFNK NK; - } U; - - union variant - { - struct Non_Extended NX; - struct Extended EX; - } V; -}; - -/* The actual tree is an array of nodes. The pointer to this array is passed - as a parameter to the tree transformer procedure and stored in the global - variable Nodes_Ptr after adjusting it by subtracting Node_First_Entry, so - that Node_Id values can be used as subscripts. */ -extern struct Node *Nodes_Ptr; - #define Parent atree__parent extern Node_Id Parent (Node_Id); #define Original_Node atree__original_node extern Node_Id Original_Node (Node_Id); -/* The auxiliary flags array which is allocated in parallel to Nodes */ - -struct Flags -{ - Boolean Flag0 : 1; - Boolean Flag1 : 1; - Boolean Flag2 : 1; - Boolean Flag3 : 1; - Boolean Spare0 : 1; - Boolean Spare1 : 1; - Boolean Spare2 : 1; - Boolean Spare3 : 1; -}; -extern struct Flags *Flags_Ptr; - -/* Overloaded Functions: - - These functions are overloaded in the original Ada source, but there is - only one corresponding C function, which works as described below. */ - /* Type used for union of Node_Id, List_Id, Elist_Id. */ typedef Int Tree_Id; @@ -400,7 +59,7 @@ No (Tree_Id N) INLINE Boolean Present (Tree_Id N) { - return N != Empty; + return !No (N); } extern Node_Id Parent (Tree_Id); @@ -408,488 +67,150 @@ extern Node_Id Parent (Tree_Id); #define Current_Error_Node atree__current_error_node extern Node_Id Current_Error_Node; -/* Node Access Functions: */ - -#define Nkind(N) ((Node_Kind) (Nodes_Ptr[(N) - First_Node_Id].U.K.kind)) -#define Ekind(N) ((Entity_Kind) (Nodes_Ptr[N + 1].U.K.kind)) -#define Sloc(N) (Nodes_Ptr[(N) - First_Node_Id].V.NX.sloc) -#define Paren_Count(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.pflag1 \ - + 2 * Nodes_Ptr[(N) - First_Node_Id].U.K.pflag2) - -#define Field1(N) (Nodes_Ptr[(N) - First_Node_Id].V.NX.field1) -#define Field2(N) (Nodes_Ptr[(N) - First_Node_Id].V.NX.field2) -#define Field3(N) (Nodes_Ptr[(N) - First_Node_Id].V.NX.field3) -#define Field4(N) (Nodes_Ptr[(N) - First_Node_Id].V.NX.field4) -#define Field5(N) (Nodes_Ptr[(N) - First_Node_Id].V.NX.field5) -#define Field6(N) (Nodes_Ptr[(N) - First_Node_Id + 1].V.EX.field6) -#define Field7(N) (Nodes_Ptr[(N) - First_Node_Id + 1].V.EX.field7) -#define Field8(N) (Nodes_Ptr[(N) - First_Node_Id + 1].V.EX.field8) -#define Field9(N) (Nodes_Ptr[(N) - First_Node_Id + 1].V.EX.field9) -#define Field10(N) (Nodes_Ptr[(N) - First_Node_Id + 1].V.EX.field10) -#define Field11(N) (Nodes_Ptr[(N) - First_Node_Id + 1].V.EX.X.field11) -#define Field12(N) (Nodes_Ptr[(N) - First_Node_Id + 1].V.EX.U.field12) -#define Field13(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.field6) -#define Field14(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.field7) -#define Field15(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.field8) -#define Field16(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.field9) -#define Field17(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.field10) -#define Field18(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.X.field11) -#define Field19(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field6) -#define Field20(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field7) -#define Field21(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field8) -#define Field22(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field9) -#define Field23(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field10) -#define Field24(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field6) -#define Field25(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field7) -#define Field26(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field8) -#define Field27(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field9) -#define Field28(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field10) -#define Field29(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.X.field11) -#define Field30(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field6) -#define Field31(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field7) -#define Field32(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field8) -#define Field33(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field9) -#define Field34(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.field10) -#define Field35(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.X.field11) -#define Field36(N) (Nodes_Ptr[(N) - First_Node_Id + 6].V.EX.field6) -#define Field37(N) (Nodes_Ptr[(N) - First_Node_Id + 6].V.EX.field7) -#define Field38(N) (Nodes_Ptr[(N) - First_Node_Id + 6].V.EX.field8) -#define Field39(N) (Nodes_Ptr[(N) - First_Node_Id + 6].V.EX.field9) -#define Field40(N) (Nodes_Ptr[(N) - First_Node_Id + 6].V.EX.field10) -#define Field41(N) (Nodes_Ptr[(N) - First_Node_Id + 6].V.EX.X.field11) - -#define Node1(N) Field1 (N) -#define Node2(N) Field2 (N) -#define Node3(N) Field3 (N) -#define Node4(N) Field4 (N) -#define Node5(N) Field5 (N) -#define Node6(N) Field6 (N) -#define Node7(N) Field7 (N) -#define Node8(N) Field8 (N) -#define Node9(N) Field9 (N) -#define Node10(N) Field10 (N) -#define Node11(N) Field11 (N) -#define Node12(N) Field12 (N) -#define Node13(N) Field13 (N) -#define Node14(N) Field14 (N) -#define Node15(N) Field15 (N) -#define Node16(N) Field16 (N) -#define Node17(N) Field17 (N) -#define Node18(N) Field18 (N) -#define Node19(N) Field19 (N) -#define Node20(N) Field20 (N) -#define Node21(N) Field21 (N) -#define Node22(N) Field22 (N) -#define Node23(N) Field23 (N) -#define Node24(N) Field24 (N) -#define Node25(N) Field25 (N) -#define Node26(N) Field26 (N) -#define Node27(N) Field27 (N) -#define Node28(N) Field28 (N) -#define Node29(N) Field29 (N) -#define Node30(N) Field30 (N) -#define Node31(N) Field31 (N) -#define Node32(N) Field32 (N) -#define Node33(N) Field33 (N) -#define Node34(N) Field34 (N) -#define Node35(N) Field35 (N) -#define Node36(N) Field36 (N) -#define Node37(N) Field37 (N) -#define Node38(N) Field38 (N) -#define Node39(N) Field39 (N) -#define Node40(N) Field40 (N) -#define Node41(N) Field41 (N) - -#define List1(N) Field1 (N) -#define List2(N) Field2 (N) -#define List3(N) Field3 (N) -#define List4(N) Field4 (N) -#define List5(N) Field5 (N) -#define List10(N) Field10 (N) -#define List14(N) Field14 (N) -#define List25(N) Field25 (N) -#define List38(N) Field38 (N) -#define List39(N) Field39 (N) - -#define Elist1(N) Field1 (N) -#define Elist2(N) Field2 (N) -#define Elist3(N) Field3 (N) -#define Elist4(N) Field4 (N) -#define Elist5(N) Field5 (N) -#define Elist8(N) Field8 (N) -#define Elist9(N) Field9 (N) -#define Elist10(N) Field10 (N) -#define Elist11(N) Field11 (N) -#define Elist13(N) Field13 (N) -#define Elist15(N) Field15 (N) -#define Elist16(N) Field16 (N) -#define Elist18(N) Field18 (N) -#define Elist21(N) Field21 (N) -#define Elist23(N) Field23 (N) -#define Elist24(N) Field24 (N) -#define Elist25(N) Field25 (N) -#define Elist26(N) Field26 (N) -#define Elist29(N) Field29 (N) -#define Elist30(N) Field30 (N) -#define Elist36(N) Field36 (N) - -#define Name1(N) Field1 (N) -#define Name2(N) Field2 (N) - -#define Char_Code2(N) (Field2 (N) - Char_Code_Bias) - -#define Str3(N) Field3 (N) +// The following code corresponds to the Get_n_Bit_Field functions (for +// various n) in package Atree. The low-level getters in sinfo.h call +// these even-lower-level getters. -#define Uint2(N) ((Field2 (N) == 0) ? Uint_0 : Field2 (N)) -#define Uint3(N) ((Field3 (N) == 0) ? Uint_0 : Field3 (N)) -#define Uint4(N) ((Field4 (N) == 0) ? Uint_0 : Field4 (N)) -#define Uint5(N) ((Field5 (N) == 0) ? Uint_0 : Field5 (N)) -#define Uint8(N) ((Field8 (N) == 0) ? Uint_0 : Field8 (N)) -#define Uint9(N) ((Field9 (N) == 0) ? Uint_0 : Field9 (N)) -#define Uint10(N) ((Field10 (N) == 0) ? Uint_0 : Field10 (N)) -#define Uint11(N) ((Field11 (N) == 0) ? Uint_0 : Field11 (N)) -#define Uint12(N) ((Field12 (N) == 0) ? Uint_0 : Field12 (N)) -#define Uint13(N) ((Field13 (N) == 0) ? Uint_0 : Field13 (N)) -#define Uint14(N) ((Field14 (N) == 0) ? Uint_0 : Field14 (N)) -#define Uint15(N) ((Field15 (N) == 0) ? Uint_0 : Field15 (N)) -#define Uint16(N) ((Field16 (N) == 0) ? Uint_0 : Field16 (N)) -#define Uint17(N) ((Field17 (N) == 0) ? Uint_0 : Field17 (N)) -#define Uint22(N) ((Field22 (N) == 0) ? Uint_0 : Field22 (N)) -#define Uint24(N) ((Field24 (N) == 0) ? Uint_0 : Field24 (N)) +extern Field_Offset *Node_Offsets_Ptr; +extern slot* Slots_Ptr; -#define Ureal3(N) Field3 (N) -#define Ureal18(N) Field18 (N) -#define Ureal21(N) Field21 (N) +static Union_Id Get_1_Bit_Field(Node_Id N, Field_Offset Offset); +static Union_Id Get_2_Bit_Field(Node_Id N, Field_Offset Offset); +static Union_Id Get_4_Bit_Field(Node_Id N, Field_Offset Offset); +static Union_Id Get_8_Bit_Field(Node_Id N, Field_Offset Offset); +static Union_Id Get_32_Bit_Field(Node_Id N, Field_Offset Offset); +static Union_Id Get_32_Bit_Field_With_Default + (Node_Id N, Field_Offset Offset, Union_Id Default_Value); -#define Analyzed(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.analyzed) -#define Comes_From_Source(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.c_f_s) -#define Error_Posted(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.error_posted) -#define Has_Aspects(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.has_aspects) -#define Convention(N) \ - (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.convention) - -#define Flag0(N) (Flags_Ptr[(N) - First_Node_Id].Flag0) -#define Flag1(N) (Flags_Ptr[(N) - First_Node_Id].Flag1) -#define Flag2(N) (Flags_Ptr[(N) - First_Node_Id].Flag2) -#define Flag3(N) (Flags_Ptr[(N) - First_Node_Id].Flag3) - -#define Flag4(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag4) -#define Flag5(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag5) -#define Flag6(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag6) -#define Flag7(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag7) -#define Flag8(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag8) -#define Flag9(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag9) -#define Flag10(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag10) -#define Flag11(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag11) -#define Flag12(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag12) -#define Flag13(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag13) -#define Flag14(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag14) -#define Flag15(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag15) -#define Flag16(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag16) -#define Flag17(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag17) -#define Flag18(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag18) +INLINE Union_Id +Get_1_Bit_Field(Node_Id N, Field_Offset Offset) +{ + const Field_Offset L = 32; + slot_1_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset/L))->slot_1; -#define Flag19(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.in_list) -#define Flag20(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.has_aspects) -#define Flag21(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.rewrite_ins) -#define Flag22(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.analyzed) -#define Flag23(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.c_f_s) -#define Flag24(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.error_posted) -#define Flag25(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag4) -#define Flag26(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag5) -#define Flag27(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag6) -#define Flag28(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag7) -#define Flag29(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag8) -#define Flag30(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag9) -#define Flag31(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag10) -#define Flag32(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag11) -#define Flag33(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag12) -#define Flag34(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag13) -#define Flag35(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag14) -#define Flag36(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag15) -#define Flag37(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag16) -#define Flag38(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag17) -#define Flag39(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag18) + switch (Offset%L) + { + case 0: return slot.f0; + case 1: return slot.f1; + case 2: return slot.f2; + case 3: return slot.f3; + case 4: return slot.f4; + case 5: return slot.f5; + case 6: return slot.f6; + case 7: return slot.f7; + case 8: return slot.f8; + case 9: return slot.f9; + case 10: return slot.f10; + case 11: return slot.f11; + case 12: return slot.f12; + case 13: return slot.f13; + case 14: return slot.f14; + case 15: return slot.f15; + case 16: return slot.f16; + case 17: return slot.f17; + case 18: return slot.f18; + case 19: return slot.f19; + case 20: return slot.f20; + case 21: return slot.f21; + case 22: return slot.f22; + case 23: return slot.f23; + case 24: return slot.f24; + case 25: return slot.f25; + case 26: return slot.f26; + case 27: return slot.f27; + case 28: return slot.f28; + case 29: return slot.f29; + case 30: return slot.f30; + case 31: return slot.f31; + default: gcc_assert(false); + } +} -#define Flag40(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.in_list) -#define Flag41(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.has_aspects) -#define Flag42(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.rewrite_ins) -#define Flag43(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.analyzed) -#define Flag44(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.c_f_s) -#define Flag45(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.error_posted) -#define Flag46(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag4) -#define Flag47(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag5) -#define Flag48(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag6) -#define Flag49(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag7) -#define Flag50(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag8) -#define Flag51(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag9) -#define Flag52(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag10) -#define Flag53(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag11) -#define Flag54(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag12) -#define Flag55(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag13) -#define Flag56(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag14) -#define Flag57(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag15) -#define Flag58(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag16) -#define Flag59(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag17) -#define Flag60(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag18) -#define Flag61(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.pflag1) -#define Flag62(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.pflag2) -#define Flag63(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.pflag1) -#define Flag64(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.pflag2) +INLINE Union_Id +Get_2_Bit_Field(Node_Id N, Field_Offset Offset) +{ + const Field_Offset L = 16; + slot_2_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset/L))->slot_2; -#define Flag65(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag65) -#define Flag66(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag66) -#define Flag67(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag67) -#define Flag68(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag68) -#define Flag69(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag69) -#define Flag70(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag70) -#define Flag71(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag71) -#define Flag72(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.NK.flag72) + switch (Offset%L) + { + case 0: return slot.f0; + case 1: return slot.f1; + case 2: return slot.f2; + case 3: return slot.f3; + case 4: return slot.f4; + case 5: return slot.f5; + case 6: return slot.f6; + case 7: return slot.f7; + case 8: return slot.f8; + case 9: return slot.f9; + case 10: return slot.f10; + case 11: return slot.f11; + case 12: return slot.f12; + case 13: return slot.f13; + case 14: return slot.f14; + case 15: return slot.f15; + default: gcc_assert(false); + } +} -#define Flag73(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag73) -#define Flag74(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag74) -#define Flag75(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag75) -#define Flag76(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag76) -#define Flag77(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag77) -#define Flag78(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag78) -#define Flag79(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag79) -#define Flag80(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag80) -#define Flag81(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag81) -#define Flag82(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag82) -#define Flag83(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag83) -#define Flag84(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag84) -#define Flag85(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag85) -#define Flag86(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag86) -#define Flag87(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag87) -#define Flag88(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag88) -#define Flag89(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag89) -#define Flag90(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag90) -#define Flag91(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag91) -#define Flag92(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag92) -#define Flag93(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag93) -#define Flag94(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag94) -#define Flag95(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag95) -#define Flag96(N) (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.flag96) -#define Flag97(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag97) -#define Flag98(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag98) -#define Flag99(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag99) -#define Flag100(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag100) -#define Flag101(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag101) -#define Flag102(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag102) -#define Flag103(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag103) -#define Flag104(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag104) -#define Flag105(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag105) -#define Flag106(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag106) -#define Flag107(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag107) -#define Flag108(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag108) -#define Flag109(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag109) -#define Flag110(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag110) -#define Flag111(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag111) -#define Flag112(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag112) -#define Flag113(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag113) -#define Flag114(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag114) -#define Flag115(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag115) -#define Flag116(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag116) -#define Flag117(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag117) -#define Flag118(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag118) -#define Flag119(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag119) -#define Flag120(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag120) -#define Flag121(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag121) -#define Flag122(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag122) -#define Flag123(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag123) -#define Flag124(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag124) -#define Flag125(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag125) -#define Flag126(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag126) -#define Flag127(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag127) -#define Flag128(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag128) +INLINE Union_Id +Get_4_Bit_Field(Node_Id N, Field_Offset Offset) +{ + const Field_Offset L = 8; + slot_4_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset/L))->slot_4; -#define Flag129(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.in_list) -#define Flag130(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.has_aspects) -#define Flag131(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.rewrite_ins) -#define Flag132(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.analyzed) -#define Flag133(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.c_f_s) -#define Flag134(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.error_posted) -#define Flag135(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag4) -#define Flag136(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag5) -#define Flag137(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag6) -#define Flag138(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag7) -#define Flag139(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag8) -#define Flag140(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag9) -#define Flag141(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag10) -#define Flag142(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag11) -#define Flag143(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag12) -#define Flag144(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag13) -#define Flag145(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag14) -#define Flag146(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag15) -#define Flag147(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag16) -#define Flag148(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag17) -#define Flag149(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag18) -#define Flag150(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.pflag1) -#define Flag151(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.pflag2) + switch (Offset%L) + { + case 0: return slot.f0; + case 1: return slot.f1; + case 2: return slot.f2; + case 3: return slot.f3; + case 4: return slot.f4; + case 5: return slot.f5; + case 6: return slot.f6; + case 7: return slot.f7; + default: gcc_assert(false); + } +} -#define Flag152(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag152) -#define Flag153(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag153) -#define Flag154(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag154) -#define Flag155(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag155) -#define Flag156(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag156) -#define Flag157(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag157) -#define Flag158(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag158) -#define Flag159(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag159) -#define Flag160(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag160) -#define Flag161(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag161) -#define Flag162(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag162) -#define Flag163(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag163) -#define Flag164(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag164) -#define Flag165(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag165) -#define Flag166(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag166) -#define Flag167(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag167) -#define Flag168(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag168) -#define Flag169(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag169) -#define Flag170(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag170) -#define Flag171(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag171) -#define Flag172(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag172) -#define Flag173(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag173) -#define Flag174(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag174) -#define Flag175(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag175) -#define Flag176(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag176) -#define Flag177(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag177) -#define Flag178(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag178) -#define Flag179(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag179) -#define Flag180(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag180) -#define Flag181(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag181) -#define Flag182(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag182) -#define Flag183(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.X.fw3.flag183) +INLINE Union_Id +Get_8_Bit_Field(Node_Id N, Field_Offset Offset) +{ + const Field_Offset L = 4; + slot_8_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset/L))->slot_8; -#define Flag184(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag184) -#define Flag185(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag185) -#define Flag186(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag186) -#define Flag187(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag187) -#define Flag188(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag188) -#define Flag189(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag189) -#define Flag190(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag190) -#define Flag191(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag191) -#define Flag192(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag192) -#define Flag193(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag193) -#define Flag194(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag194) -#define Flag195(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag195) -#define Flag196(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag196) -#define Flag197(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag197) -#define Flag198(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag198) -#define Flag199(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag199) -#define Flag200(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag200) -#define Flag201(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag201) -#define Flag202(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag202) -#define Flag203(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag203) -#define Flag204(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag204) -#define Flag205(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag205) -#define Flag206(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag206) -#define Flag207(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag207) -#define Flag208(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag208) -#define Flag209(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag209) -#define Flag210(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag210) -#define Flag211(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag211) -#define Flag212(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag212) -#define Flag213(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag213) -#define Flag214(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag214) -#define Flag215(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag215) + switch (Offset%L) + { + case 0: return slot.f0; + case 1: return slot.f1; + case 2: return slot.f2; + case 3: return slot.f3; + default: gcc_assert(false); + } +} -#define Flag216(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.in_list) -#define Flag217(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.has_aspects) -#define Flag218(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.rewrite_ins) -#define Flag219(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.analyzed) -#define Flag220(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.c_f_s) -#define Flag221(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.error_posted) -#define Flag222(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag4) -#define Flag223(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag5) -#define Flag224(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag6) -#define Flag225(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag7) -#define Flag226(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag8) -#define Flag227(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag9) -#define Flag228(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag10) -#define Flag229(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag11) -#define Flag230(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag12) -#define Flag231(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag13) -#define Flag232(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag14) -#define Flag233(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag15) -#define Flag234(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag16) -#define Flag235(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag17) -#define Flag236(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag18) -#define Flag237(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.pflag1) -#define Flag238(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.pflag2) +INLINE Union_Id +Get_32_Bit_Field(Node_Id N, Field_Offset Offset) +{ + const Field_Offset L = 1; + slot_32_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset/L))->slot_32; + return slot; +} -#define Flag239(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag65) -#define Flag240(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag66) -#define Flag241(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag67) -#define Flag242(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag68) -#define Flag243(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag69) -#define Flag244(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag70) -#define Flag245(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag71) -#define Flag246(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.NK.flag72) +INLINE Union_Id +Get_32_Bit_Field_With_Default(Node_Id N, Field_Offset Offset, Union_Id Default_Value) +{ + const Field_Offset L = 1; + slot_32_bit slot = (Slots_Ptr + (Node_Offsets_Ptr[N] + Offset/L))->slot_32; -#define Flag247(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag65) -#define Flag248(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag66) -#define Flag249(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag67) -#define Flag250(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag68) -#define Flag251(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag69) -#define Flag252(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag70) -#define Flag253(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag71) -#define Flag254(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.NK.flag72) + if (slot == Empty) + { + return Default_Value; + } -#define Flag255(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag255) -#define Flag256(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag256) -#define Flag257(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag257) -#define Flag258(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag258) -#define Flag259(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag259) -#define Flag260(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag260) -#define Flag261(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag261) -#define Flag262(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag262) -#define Flag263(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag263) -#define Flag264(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag264) -#define Flag265(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag265) -#define Flag266(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag266) -#define Flag267(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag267) -#define Flag268(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag268) -#define Flag269(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag269) -#define Flag270(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag270) -#define Flag271(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag271) -#define Flag272(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag272) -#define Flag273(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag273) -#define Flag274(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag274) -#define Flag275(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag275) -#define Flag276(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag276) -#define Flag277(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag277) -#define Flag278(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag278) -#define Flag279(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag279) -#define Flag280(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag280) -#define Flag281(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag281) -#define Flag282(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag282) -#define Flag283(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag283) -#define Flag284(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag284) -#define Flag285(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag285) -#define Flag286(N) (Nodes_Ptr[(N) - First_Node_Id + 5].V.EX.U.fw5.flag286) -#define Flag287(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.in_list) -#define Flag288(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.has_aspects) -#define Flag289(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.rewrite_ins) -#define Flag290(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.analyzed) -#define Flag291(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.c_f_s) -#define Flag292(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.error_posted) -#define Flag293(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag4) -#define Flag294(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag5) -#define Flag295(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag6) -#define Flag296(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag7) -#define Flag297(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag8) -#define Flag298(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag9) -#define Flag299(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag10) -#define Flag300(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag11) -#define Flag301(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag12) -#define Flag302(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag13) -#define Flag303(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag14) -#define Flag304(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag15) -#define Flag305(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag16) -#define Flag306(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag17) -#define Flag307(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag18) -#define Flag308(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.pflag1) -#define Flag309(N) (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.pflag2) + return slot; +} #ifdef __cplusplus } diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index 597bb8ccaf7..a170ed5fbaf 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -88,8 +88,8 @@ package body Back_End is (gnat_root : Int; max_gnat_node : Int; number_name : Nat; - nodes_ptr : Address; - flags_ptr : Address; + node_offsets_ptr : Address; + slots_ptr : Address; next_node_ptr : Address; prev_node_ptr : Address; @@ -156,8 +156,8 @@ package body Back_End is (gnat_root => Int (Cunit (Main_Unit)), max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1), number_name => Name_Entries_Count, - nodes_ptr => Nodes_Address, - flags_ptr => Flags_Address, + node_offsets_ptr => Node_Offsets_Address, + slots_ptr => Slots_Address, next_node_ptr => Next_Node_Address, prev_node_ptr => Prev_Node_Address, diff --git a/gcc/ada/ceinfo.adb b/gcc/ada/ceinfo.adb deleted file mode 100644 index ccb53cefe45..00000000000 --- a/gcc/ada/ceinfo.adb +++ /dev/null @@ -1,226 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- C E I N F O -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-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. -- --- -- ------------------------------------------------------------------------------- - --- Check consistency of einfo.ads and einfo.adb. Checks that field name usage --- is consistent, including comments mentioning fields. - --- Note that this is used both as a standalone program, and as a procedure --- called by XEinfo. This raises an unhandled exception if it finds any --- errors; we don't attempt any sophisticated error recovery. - -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; -with GNAT.Spitbol.Table_VString; - -procedure CEinfo is - - package TV renames GNAT.Spitbol.Table_VString; - use TV; - - Infil : File_Type; - Lineno : Natural := 0; - - Err : exception; - -- Raised on error - - Fieldnm : VString; - Accessfunc : VString; - Line : VString; - - Fields : GNAT.Spitbol.Table_VString.Table (500); - -- Maps field names to underlying field access name - - UC : constant Pattern := Any ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); - - Fnam : constant Pattern := (UC & Break (' ')) * Fieldnm; - - Field_Def : constant Pattern := - "-- " & Fnam & " (" & Break (')') * Accessfunc; - - Field_Ref : constant Pattern := - " -- " & Fnam & Break ('(') & Len (1) & - Break (')') * Accessfunc; - - Field_Com : constant Pattern := " -- " & Fnam & Span (' ') & - (Break (' ') or Rest) * Accessfunc; - - Func_Hedr : constant Pattern := " function " & Fnam; - - Func_Retn : constant Pattern := " return " & Break (' ') * Accessfunc; - - Proc_Hedr : constant Pattern := " procedure " & Fnam; - - Proc_Setf : constant Pattern := " Set_" & Break (' ') * Accessfunc; - - procedure Next_Line; - -- Read next line trimmed from Infil into Line and bump Lineno - - procedure Next_Line is - begin - Line := Get_Line (Infil); - Trim (Line); - Lineno := Lineno + 1; - end Next_Line; - --- Start of processing for CEinfo - -begin - Anchored_Mode := True; - New_Line; - Open (Infil, In_File, "einfo.ads"); - - Put_Line ("Acquiring field names from spec"); - - loop - Next_Line; - - -- Old format of einfo.ads - - exit when Match (Line, " -- Access Kinds --"); - - -- New format of einfo.ads - - exit when Match (Line, "-- Access Kinds --"); - - if Match (Line, Field_Def) then - Set (Fields, Fieldnm, Accessfunc); - end if; - end loop; - - Put_Line ("Checking consistent references in spec"); - - loop - Next_Line; - exit when Match (Line, " -- Description of Defined"); - end loop; - - loop - Next_Line; - exit when Match (Line, " -- Component_Alignment Control"); - - if Match (Line, Field_Ref) then - if Accessfunc /= "synth" - and then - Accessfunc /= "special" - and then - Accessfunc /= Get (Fields, Fieldnm) - then - if Present (Fields, Fieldnm) then - Put_Line ("*** field name incorrect at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - - else - Put_Line - ("*** unknown field name " & Fieldnm & " at line " & Lineno); - end if; - - raise Err; - end if; - end if; - end loop; - - Close (Infil); - Open (Infil, In_File, "einfo.adb"); - Lineno := 0; - - Put_Line ("Check listing of fields in body"); - - loop - Next_Line; - exit when Match (Line, " -- Attribute Access Functions --"); - - if Match (Line, Field_Com) - and then Fieldnm /= "(unused)" - and then Accessfunc /= Get (Fields, Fieldnm) - then - if Present (Fields, Fieldnm) then - Put_Line ("*** field name incorrect at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - - else - Put_Line - ("*** unknown field name " & Fieldnm & " at line " & Lineno); - end if; - - raise Err; - end if; - end loop; - - Put_Line ("Check references in access routines in body"); - - loop - Next_Line; - exit when Match (Line, " -- Classification Functions --"); - - if Match (Line, Func_Hedr) then - null; - - elsif Match (Line, Func_Retn) - and then Accessfunc /= Get (Fields, Fieldnm) - and then Fieldnm /= "Mechanism" - then - Put_Line ("*** incorrect field at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - raise Err; - end if; - end loop; - - Put_Line ("Check references in set routines in body"); - - loop - Next_Line; - exit when Match (Line, " -- Attribute Set Procedures"); - end loop; - - loop - Next_Line; - exit when Match (Line, " ------------"); - - if Match (Line, Proc_Hedr) then - null; - - elsif Match (Line, Proc_Setf) - and then Accessfunc /= Get (Fields, Fieldnm) - and then Fieldnm /= "Mechanism" - then - Put_Line ("*** incorrect field at line " & Lineno); - Put_Line (" found field " & Accessfunc); - Put_Line (" expecting field " & Get (Fields, Fieldnm)); - raise Err; - end if; - end loop; - - Close (Infil); - - Put_Line ("All tests completed successfully, no errors detected"); - -end CEinfo; diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 6487944f23e..22b2b6909bc 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -26,7 +26,9 @@ with Atree; use Atree; with Casing; use Casing; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Eval_Fat; use Eval_Fat; with Exp_Ch11; use Exp_Ch11; @@ -53,7 +55,9 @@ with Sem_Mech; use Sem_Mech; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Sprint; use Sprint; @@ -9295,7 +9299,6 @@ package body Checks is Append_To (New_Alts, Make_Case_Expression_Alternative (Sloc (Alt), - Actions => No_List, Discrete_Choices => Discrete_Choices (Alt), Expression => New_Exp)); diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 0e480a041e1..252a0c4d700 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -36,7 +36,8 @@ with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Output; use Output; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Sinput; use Sinput; with Sprint; use Sprint; with Sdefault; use Sdefault; diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index a4d6b491a76..61345ea31b7 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -25,7 +25,9 @@ with Aspects; use Aspects; with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Prag; use Exp_Prag; @@ -46,7 +48,9 @@ with Sem_Ch13; use Sem_Ch13; with Sem_Disp; use Sem_Disp; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb deleted file mode 100644 index a8084ca7b1d..00000000000 --- a/gcc/ada/csinfo.adb +++ /dev/null @@ -1,639 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- C S I N F O -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-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. -- --- -- ------------------------------------------------------------------------------- - --- Check consistency of sinfo.ads and sinfo.adb. Checks that field name usage --- is consistent and that assertion cross-reference lists are correct, as well --- as making sure that all the comments on field name usage are consistent. - --- Note that this is used both as a standalone program, and as a procedure --- called by XSinfo. This raises an unhandled exception if it finds any --- errors; we don't attempt any sophisticated error recovery. - -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Strings.Maps; use Ada.Strings.Maps; -with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; -with GNAT.Spitbol.Table_Boolean; -with GNAT.Spitbol.Table_VString; - -procedure CSinfo is - - package TB renames GNAT.Spitbol.Table_Boolean; - package TV renames GNAT.Spitbol.Table_VString; - use TB, TV; - - Infil : File_Type; - Lineno : Natural := 0; - - Err : exception; - -- Raised on fatal error - - Done : exception; - -- Raised after error is found to terminate run - - WSP : constant Pattern := Span (' ' & ASCII.HT); - - Fields : TV.Table (300); - Fields1 : TV.Table (300); - Refs : TV.Table (300); - Refscopy : TV.Table (300); - Special : TB.Table (50); - Inlines : TV.Table (100); - - -- The following define the standard fields used for binary operator, - -- unary operator, and other expression nodes. Numbers in the range 1-5 - -- refer to the Fieldn fields. Letters D-R refer to flags: - - -- D = Flag4 - -- E = Flag5 - -- F = Flag6 - -- G = Flag7 - -- H = Flag8 - -- I = Flag9 - -- J = Flag10 - -- K = Flag11 - -- L = Flag12 - -- M = Flag13 - -- N = Flag14 - -- O = Flag15 - -- P = Flag16 - -- Q = Flag17 - -- R = Flag18 - - Flags : TV.Table (20); - -- Maps flag numbers to letters - - N_Fields : constant Pattern := BreakX ("J"); - E_Fields : constant Pattern := BreakX ("5EFGHIJOP"); - U_Fields : constant Pattern := BreakX ("1345EFGHIJKOPQ"); - B_Fields : constant Pattern := BreakX ("12345EFGHIJKOPQ"); - - Line : VString; - Bad : Boolean; - - Field : constant VString := Nul; - Fields_Used : VString := Nul; - Name : constant VString := Nul; - Next : constant VString := Nul; - Node : VString := Nul; - Ref : VString := Nul; - Synonym : constant VString := Nul; - Nxtref : constant VString := Nul; - - Which_Field : aliased VString := Nul; - - Node_Search : constant Pattern := WSP & "-- N_" & Rest * Node; - Break_Punc : constant Pattern := Break (" .,"); - Plus_Binary : constant Pattern := WSP - & "-- plus fields for binary operator"; - Plus_Unary : constant Pattern := WSP - & "-- plus fields for unary operator"; - Plus_Expr : constant Pattern := WSP - & "-- plus fields for expression"; - Break_Syn : constant Pattern := WSP & "-- " - & Break (' ') * Synonym - & " (" & Break (')') * Field; - Break_Field : constant Pattern := BreakX ('-') * Field; - Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) - & Span (Decimal_Digit_Set) * Which_Field; - Break_WFld : constant Pattern := Break (Which_Field'Access); - Get_Funcsyn : constant Pattern := WSP & "function " & Rest * Synonym; - Extr_Field : constant Pattern := BreakX ('-') & "-- " & Rest * Field; - Get_Procsyn : constant Pattern := WSP & "procedure Set_" & Rest * Synonym; - Get_Inline : constant Pattern := WSP & "pragma Inline (" - & Break (')') * Name; - Set_Name : constant Pattern := "Set_" & Rest * Name; - Func_Rest : constant Pattern := " function " & Rest * Synonym; - Get_Nxtref : constant Pattern := Break (',') * Nxtref & ','; - Test_Syn : constant Pattern := Break ('=') & "= N_" - & (Break (" ,)") or Rest) * Next; - Chop_Comma : constant Pattern := BreakX (',') * Next; - Return_Fld : constant Pattern := WSP & "return " & Break (' ') * Field; - Set_Syn : constant Pattern := " procedure Set_" & Rest * Synonym; - Set_Fld : constant Pattern := WSP & "Set_" & Break (' ') * Field - & " (N, Val)"; - Break_With : constant Pattern := Break ('_') ** Field & "_With_Parent"; - - type VStringA is array (Natural range <>) of VString; - - procedure Next_Line; - -- Read next line trimmed from Infil into Line and bump Lineno - - procedure Sort (A : in out VStringA); - -- Sort a (small) array of VString's - - procedure Next_Line is - begin - Line := Get_Line (Infil); - Trim (Line); - Lineno := Lineno + 1; - end Next_Line; - - procedure Sort (A : in out VStringA) is - Temp : VString; - begin - <<Sort>> - for J in 1 .. A'Length - 1 loop - if A (J) > A (J + 1) then - Temp := A (J); - A (J) := A (J + 1); - A (J + 1) := Temp; - goto Sort; - end if; - end loop; - end Sort; - --- Start of processing for CSinfo - -begin - Anchored_Mode := True; - New_Line; - Open (Infil, In_File, "sinfo.ads"); - Put_Line ("Check for field name consistency"); - - -- Setup table for mapping flag numbers to letters - - Set (Flags, "4", V ("D")); - Set (Flags, "5", V ("E")); - Set (Flags, "6", V ("F")); - Set (Flags, "7", V ("G")); - Set (Flags, "8", V ("H")); - Set (Flags, "9", V ("I")); - Set (Flags, "10", V ("J")); - Set (Flags, "11", V ("K")); - Set (Flags, "12", V ("L")); - Set (Flags, "13", V ("M")); - Set (Flags, "14", V ("N")); - Set (Flags, "15", V ("O")); - Set (Flags, "16", V ("P")); - Set (Flags, "17", V ("Q")); - Set (Flags, "18", V ("R")); - - -- Special fields table. The following names are not recorded or checked - -- by Csinfo, since they are specially handled. This means that any field - -- definition or subprogram with a matching name is ignored. - - Set (Special, "Analyzed", True); - Set (Special, "Assignment_OK", True); - Set (Special, "Associated_Node", True); - Set (Special, "Cannot_Be_Constant", True); - Set (Special, "Chars", True); - Set (Special, "Comes_From_Source", True); - Set (Special, "Do_Overflow_Check", True); - Set (Special, "Do_Range_Check", True); - Set (Special, "Entity", True); - Set (Special, "Entity_Or_Associated_Node", True); - Set (Special, "Error_Posted", True); - Set (Special, "Etype", True); - Set (Special, "Evaluate_Once", True); - Set (Special, "First_Itype", True); - Set (Special, "Has_Aspect_Specifications", True); - Set (Special, "Has_Dynamic_Itype", True); - Set (Special, "Has_Dynamic_Length_Check", True); - Set (Special, "Has_Private_View", True); - Set (Special, "Is_Controlling_Actual", True); - Set (Special, "Is_Overloaded", True); - Set (Special, "Is_Static_Expression", True); - Set (Special, "Left_Opnd", True); - Set (Special, "Must_Not_Freeze", True); - Set (Special, "Nkind_In", True); - Set (Special, "Parens", True); - Set (Special, "Pragma_Name", True); - Set (Special, "Raises_Constraint_Error", True); - Set (Special, "Right_Opnd", True); - - -- Loop to acquire information from node definitions in sinfo.ads, - -- checking for consistency in Op/Flag assignments to each synonym - - loop - Bad := False; - Next_Line; - exit when Match (Line, " -- Node Access Functions"); - - if Match (Line, Node_Search) - and then not Match (Node, Break_Punc) - then - Fields_Used := Nul; - - elsif Node = "" then - null; - - elsif Line = "" then - Node := Nul; - - elsif Match (Line, Plus_Binary) then - Bad := Match (Fields_Used, B_Fields); - - elsif Match (Line, Plus_Unary) then - Bad := Match (Fields_Used, U_Fields); - - elsif Match (Line, Plus_Expr) then - Bad := Match (Fields_Used, E_Fields); - - elsif not Match (Line, Break_Syn) then - null; - - elsif Match (Synonym, "plus") then - null; - - else - Match (Field, Break_Field); - - if not Present (Special, Synonym) then - if Present (Fields, Synonym) then - if Field /= Get (Fields, Synonym) then - Put_Line - ("Inconsistent field reference at line" & - Lineno'Img & " for " & Synonym); - raise Done; - end if; - - else - Set (Fields, Synonym, Field); - end if; - - Set (Refs, Synonym, Node & ',' & Get (Refs, Synonym)); - Match (Field, Get_Field); - - if Match (Field, "Flag") then - Which_Field := Get (Flags, Which_Field); - end if; - - if Match (Fields_Used, Break_WFld) then - Put_Line - ("Overlapping field at line " & Lineno'Img & - " for " & Synonym); - raise Done; - end if; - - Append (Fields_Used, Which_Field); - Bad := Bad or Match (Fields_Used, N_Fields); - end if; - end if; - - if Bad then - Put_Line ("fields conflict with standard fields for node " & Node); - raise Done; - end if; - end loop; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check for function consistency"); - - -- Loop through field function definitions to make sure they are OK - - Fields1 := Fields; - loop - Next_Line; - exit when Match (Line, " -- Node Update"); - - if Match (Line, Get_Funcsyn) - and then not Present (Special, Synonym) - then - if not Present (Fields1, Synonym) then - Put_Line - ("function on line " & Lineno & - " is for unused synonym"); - raise Done; - end if; - - Next_Line; - - if not Match (Line, Extr_Field) then - raise Err; - end if; - - if Field /= Get (Fields1, Synonym) then - Put_Line ("Wrong field in function " & Synonym); - raise Done; - - else - Delete (Fields1, Synonym); - end if; - end if; - end loop; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check for missing functions"); - - declare - List : constant TV.Table_Array := Convert_To_Array (Fields1); - - begin - if List'Length > 0 then - Put_Line ("No function for field synonym " & List (1).Name); - raise Done; - end if; - end; - - -- Check field set procedures - - Put_Line (" OK"); - New_Line; - Put_Line ("Check for set procedure consistency"); - - Fields1 := Fields; - loop - Next_Line; - exit when Match (Line, " -- Inline Pragmas"); - exit when Match (Line, " -- Iterator Procedures"); - - if Match (Line, Get_Procsyn) - and then not Present (Special, Synonym) - then - if not Present (Fields1, Synonym) then - Put_Line - ("procedure on line " & Lineno & " is for unused synonym"); - raise Done; - end if; - - Next_Line; - - if not Match (Line, Extr_Field) then - raise Err; - end if; - - if Field /= Get (Fields1, Synonym) then - Put_Line ("Wrong field in procedure Set_" & Synonym); - raise Done; - - else - Delete (Fields1, Synonym); - end if; - end if; - end loop; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check for missing set procedures"); - - declare - List : constant TV.Table_Array := Convert_To_Array (Fields1); - - begin - if List'Length > 0 then - Put_Line ("No procedure for field synonym Set_" & List (1).Name); - raise Done; - end if; - end; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check pragma Inlines are all for existing subprograms"); - - Clear (Fields1); - while not End_Of_File (Infil) loop - Next_Line; - - if Match (Line, Get_Inline) - and then not Present (Special, Name) - then - exit when Match (Name, Set_Name); - - if not Present (Fields, Name) then - Put_Line - ("Pragma Inline on line " & Lineno & - " does not correspond to synonym"); - raise Done; - - else - Set (Inlines, Name, Get (Inlines, Name) & 'r'); - end if; - end if; - end loop; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check no pragma Inlines were omitted"); - - declare - List : constant TV.Table_Array := Convert_To_Array (Fields); - Nxt : VString := Nul; - - begin - for M in List'Range loop - Nxt := List (M).Name; - - if Get (Inlines, Nxt) /= "r" then - Put_Line ("Incorrect pragma Inlines for " & Nxt); - raise Done; - end if; - end loop; - end; - - Put_Line (" OK"); - New_Line; - Clear (Inlines); - - Close (Infil); - Open (Infil, In_File, "sinfo.adb"); - Lineno := 0; - Put_Line ("Check references in functions in body"); - - Refscopy := Refs; - loop - Next_Line; - exit when Match (Line, " -- Field Access Functions --"); - end loop; - - loop - Next_Line; - exit when Match (Line, " -- Field Set Procedures --"); - - if Match (Line, Func_Rest) - and then not Present (Special, Synonym) - then - Ref := Get (Refs, Synonym); - Delete (Refs, Synonym); - - if Ref = "" then - Put_Line - ("Function on line " & Lineno & " is for unknown synonym"); - raise Err; - end if; - - -- Alpha sort of references for this entry - - declare - Refa : VStringA (1 .. 100); - N : Natural := 0; - - begin - loop - exit when not Match (Ref, Get_Nxtref, Nul); - N := N + 1; - Refa (N) := Nxtref; - end loop; - - Sort (Refa (1 .. N)); - Next_Line; - Next_Line; - Next_Line; - - -- Checking references for one entry - - for M in 1 .. N loop - Next_Line; - - if not Match (Line, Test_Syn) then - Put_Line ("Expecting N_" & Refa (M) & " at line " & Lineno); - raise Done; - end if; - - Match (Next, Chop_Comma); - - if Next /= Refa (M) then - Put_Line ("Expecting N_" & Refa (M) & " at line " & Lineno); - raise Done; - end if; - end loop; - - Next_Line; - Match (Line, Return_Fld); - - if Field /= Get (Fields, Synonym) then - Put_Line - ("Wrong field for function " & Synonym & " at line " & - Lineno & " should be " & Get (Fields, Synonym)); - raise Done; - end if; - end; - end if; - end loop; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check for missing functions in body"); - - declare - List : constant TV.Table_Array := Convert_To_Array (Refs); - - begin - if List'Length /= 0 then - Put_Line ("Missing function " & List (1).Name & " in body"); - raise Done; - end if; - end; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check Set procedures in body"); - Refs := Refscopy; - - loop - Next_Line; - exit when Match (Line, "end"); - exit when Match (Line, " -- Iterator Procedures"); - - if Match (Line, Set_Syn) - and then not Present (Special, Synonym) - then - Ref := Get (Refs, Synonym); - Delete (Refs, Synonym); - - if Ref = "" then - Put_Line - ("Function on line " & Lineno & " is for unknown synonym"); - raise Err; - end if; - - -- Alpha sort of references for this entry - - declare - Refa : VStringA (1 .. 100); - N : Natural; - - begin - N := 0; - - loop - exit when not Match (Ref, Get_Nxtref, Nul); - N := N + 1; - Refa (N) := Nxtref; - end loop; - - Sort (Refa (1 .. N)); - - Next_Line; - Next_Line; - Next_Line; - - -- Checking references for one entry - - for M in 1 .. N loop - Next_Line; - - if not Match (Line, Test_Syn) - or else Next /= Refa (M) - then - Put_Line ("Expecting N_" & Refa (M) & " at line " & Lineno); - raise Err; - end if; - end loop; - - loop - Next_Line; - exit when Match (Line, Set_Fld); - end loop; - - Match (Field, Break_With); - - if Field /= Get (Fields, Synonym) then - Put_Line - ("Wrong field for procedure Set_" & Synonym & - " at line " & Lineno & " should be " & - Get (Fields, Synonym)); - raise Done; - end if; - - Delete (Fields1, Synonym); - end; - end if; - end loop; - - Put_Line (" OK"); - New_Line; - Put_Line ("Check for missing set procedures in body"); - - declare - List : constant TV.Table_Array := Convert_To_Array (Fields1); - begin - if List'Length /= 0 then - Put_Line ("Missing procedure Set_" & List (1).Name & " in body"); - raise Done; - end if; - end; - - Put_Line (" OK"); - New_Line; - Put_Line ("All tests completed successfully, no errors detected"); - -end CSinfo; diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index d15708bdbba..7f9849465eb 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -26,7 +26,9 @@ with Atree; use Atree; with Csets; use Csets; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Layout; use Layout; with Namet; use Namet; @@ -40,7 +42,9 @@ with Tbuild; use Tbuild; with Ttypes; use Ttypes; with Sem_Mech; use Sem_Mech; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Uintp; use Uintp; @@ -1105,7 +1109,7 @@ package body CStand is -- Create semantic phase entities Standard_Void_Type := New_Standard_Entity ("_void_type"); - Set_Ekind (Standard_Void_Type, E_Void); + pragma Assert (Ekind (Standard_Void_Type) = E_Void); -- it's the default Set_Etype (Standard_Void_Type, Standard_Void_Type); Set_Scope (Standard_Void_Type, Standard_Standard); diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index d3fcf8a9500..e2c72289f6d 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -112,7 +112,7 @@ package body Debug is -- d.y Disable implicit pragma Elaborate_All on task bodies -- d.z Restore previous support for frontend handling of Inline_Always - -- d.A Print Atree statistics + -- d.A -- d.B Generate a bug box on abort_statement -- d.C Generate concatenation call, do not generate inline code -- d.D Disable errors on use of overriding keyword in Ada 95 mode @@ -125,7 +125,7 @@ package body Debug is -- d.K Do not reject components in extensions overlapping with parent -- d.L Depend on back end for limited types in if and case expressions -- d.M Relaxed RM semantics - -- d.N Add node to all entities + -- d.N -- d.O Dump internal SCO tables -- d.P Previous (non-optimized) handling of length comparisons -- d.Q Previous (incomplete) style check for binary operators @@ -160,7 +160,7 @@ package body Debug is -- d_s Stop elaboration checks on synchronous suspension -- d_t -- d_u - -- d_v + -- d_v Enable additional checks and debug printouts in Atree -- d_w -- d_x Disable inline expansion of Image attribute for enumeration types -- d_y @@ -830,8 +830,6 @@ package body Debug is -- handling of Inline_Always by the front end on such targets. For the -- targets that do not use the GCC back end, this switch is ignored. - -- d.A Print Atree statistics - -- d.B Generate a bug box when we see an abort_statement, even though -- there is no bug. Useful for testing Comperr.Compiler_Abort: write -- some code containing an abort_statement, and compile it with @@ -900,10 +898,6 @@ package body Debug is -- d.M Relaxed RM semantics. This flag sets Opt.Relaxed_RM_Semantics -- See Opt.Relaxed_RM_Semantics for more details. - -- d.N Enlarge entities by one node (but don't attempt to use this extra - -- node for storage of any flags or fields). This can be used to do - -- experiments on the impact of increasing entity sizes. - -- d.O Dump internal SCO tables. Before outputting the SCO information to -- the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table) -- are dumped for debugging purposes. @@ -990,6 +984,8 @@ package body Debug is -- a call to routine Ada.Synchronous_Task_Control.Suspend_Until_True -- or Ada.Synchronous_Barriers.Wait_For_Release. + -- d_v Enable additional checks and debug printouts in Atree + -- d_x The compiler does not expand in line the Image attribute for user- -- defined enumeration types and the standard boolean type. diff --git a/gcc/ada/debug_a.adb b/gcc/ada/debug_a.adb index c92cbd4a2e2..571603038b7 100644 --- a/gcc/ada/debug_a.adb +++ b/gcc/ada/debug_a.adb @@ -25,7 +25,8 @@ with Atree; use Atree; with Debug; use Debug; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Sinput; use Sinput; with Output; use Output; diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb new file mode 100644 index 00000000000..53ea5ca5997 --- /dev/null +++ b/gcc/ada/einfo-utils.adb @@ -0,0 +1,3339 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- E 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; use Atree; +with Elists; use Elists; +with Nlists; use Nlists; +with Output; use Output; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; + +package body Einfo.Utils is + + ----------------------- + -- Local subprograms -- + ----------------------- + + function Has_Option + (State_Id : Entity_Id; + Option_Nam : Name_Id) return Boolean; + -- Determine whether abstract state State_Id has particular option denoted + -- by the name Option_Nam. + + ---------------- + -- Has_Option -- + ---------------- + + function Has_Option + (State_Id : Entity_Id; + Option_Nam : Name_Id) return Boolean + is + Decl : constant Node_Id := Parent (State_Id); + Opt : Node_Id; + Opt_Nam : Node_Id; + + begin + pragma Assert (Ekind (State_Id) = E_Abstract_State); + + -- The declaration of abstract states with options appear as an + -- extension aggregate. If this is not the case, the option is not + -- available. + + if Nkind (Decl) /= N_Extension_Aggregate then + return False; + end if; + + -- Simple options + + Opt := First (Expressions (Decl)); + while Present (Opt) loop + if Nkind (Opt) = N_Identifier and then Chars (Opt) = Option_Nam then + return True; + end if; + + Next (Opt); + end loop; + + -- Complex options with various specifiers + + Opt := First (Component_Associations (Decl)); + while Present (Opt) loop + Opt_Nam := First (Choices (Opt)); + + if Nkind (Opt_Nam) = N_Identifier + and then Chars (Opt_Nam) = Option_Nam + then + return True; + end if; + + Next (Opt); + end loop; + + return False; + end Has_Option; + + ------------------------------ + -- Classification Functions -- + ------------------------------ + + function Is_Access_Object_Type (Id : E) return B is + begin + return Is_Access_Type (Id) and then not Is_Access_Subprogram_Type (Id); + end Is_Access_Object_Type; + + function Is_Access_Type (Id : E) return B is + begin + return Ekind (Id) in Access_Kind; + end Is_Access_Type; + + function Is_Access_Protected_Subprogram_Type (Id : E) return B is + begin + return Ekind (Id) in Access_Protected_Kind; + end Is_Access_Protected_Subprogram_Type; + + function Is_Access_Subprogram_Type (Id : E) return B is + begin + return Ekind (Id) in Access_Subprogram_Kind; + end Is_Access_Subprogram_Type; + + function Is_Aggregate_Type (Id : E) return B is + begin + return Ekind (Id) in Aggregate_Kind; + end Is_Aggregate_Type; + + function Is_Anonymous_Access_Type (Id : E) return B is + begin + return Ekind (Id) in Anonymous_Access_Kind; + end Is_Anonymous_Access_Type; + + function Is_Array_Type (Id : E) return B is + begin + return Ekind (Id) in Array_Kind; + end Is_Array_Type; + + function Is_Assignable (Id : E) return B is + begin + return Ekind (Id) in Assignable_Kind; + end Is_Assignable; + + function Is_Class_Wide_Type (Id : E) return B is + begin + return Ekind (Id) in Class_Wide_Kind; + end Is_Class_Wide_Type; + + function Is_Composite_Type (Id : E) return B is + begin + return Ekind (Id) in Composite_Kind; + end Is_Composite_Type; + + function Is_Concurrent_Body (Id : E) return B is + begin + return Ekind (Id) in Concurrent_Body_Kind; + end Is_Concurrent_Body; + + function Is_Concurrent_Type (Id : E) return B is + begin + return Ekind (Id) in Concurrent_Kind; + end Is_Concurrent_Type; + + function Is_Decimal_Fixed_Point_Type (Id : E) return B is + begin + return Ekind (Id) in Decimal_Fixed_Point_Kind; + end Is_Decimal_Fixed_Point_Type; + + function Is_Digits_Type (Id : E) return B is + begin + return Ekind (Id) in Digits_Kind; + end Is_Digits_Type; + + function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is + begin + return Ekind (Id) in Discrete_Or_Fixed_Point_Kind; + end Is_Discrete_Or_Fixed_Point_Type; + + function Is_Discrete_Type (Id : E) return B is + begin + return Ekind (Id) in Discrete_Kind; + end Is_Discrete_Type; + + function Is_Elementary_Type (Id : E) return B is + begin + return Ekind (Id) in Elementary_Kind; + end Is_Elementary_Type; + + function Is_Entry (Id : E) return B is + begin + return Ekind (Id) in Entry_Kind; + end Is_Entry; + + function Is_Enumeration_Type (Id : E) return B is + begin + return Ekind (Id) in Enumeration_Kind; + end Is_Enumeration_Type; + + function Is_Fixed_Point_Type (Id : E) return B is + begin + return Ekind (Id) in Fixed_Point_Kind; + end Is_Fixed_Point_Type; + + function Is_Floating_Point_Type (Id : E) return B is + begin + return Ekind (Id) in Float_Kind; + end Is_Floating_Point_Type; + + function Is_Formal (Id : E) return B is + begin + return Ekind (Id) in Formal_Kind; + end Is_Formal; + + function Is_Formal_Object (Id : E) return B is + begin + return Ekind (Id) in Formal_Object_Kind; + end Is_Formal_Object; + + function Is_Generic_Subprogram (Id : E) return B is + begin + return Ekind (Id) in Generic_Subprogram_Kind; + end Is_Generic_Subprogram; + + function Is_Generic_Unit (Id : E) return B is + begin + return Ekind (Id) in Generic_Unit_Kind; + end Is_Generic_Unit; + + function Is_Ghost_Entity (Id : Entity_Id) return Boolean is + begin + return Is_Checked_Ghost_Entity (Id) or else Is_Ignored_Ghost_Entity (Id); + end Is_Ghost_Entity; + + function Is_Incomplete_Or_Private_Type (Id : E) return B is + begin + return Ekind (Id) in Incomplete_Or_Private_Kind; + end Is_Incomplete_Or_Private_Type; + + function Is_Incomplete_Type (Id : E) return B is + begin + return Ekind (Id) in Incomplete_Kind; + end Is_Incomplete_Type; + + function Is_Integer_Type (Id : E) return B is + begin + return Ekind (Id) in Integer_Kind; + end Is_Integer_Type; + + function Is_Modular_Integer_Type (Id : E) return B is + begin + return Ekind (Id) in Modular_Integer_Kind; + end Is_Modular_Integer_Type; + + function Is_Named_Access_Type (Id : E) return B is + begin + return Ekind (Id) in E_Access_Type .. -- ???? + E_Access_Protected_Subprogram_Type; + end Is_Named_Access_Type; + + function Is_Named_Number (Id : E) return B is + begin + return Ekind (Id) in Named_Kind; + end Is_Named_Number; + + function Is_Numeric_Type (Id : E) return B is + begin + return Ekind (Id) in Numeric_Kind; + end Is_Numeric_Type; + + function Is_Object (Id : E) return B is + begin + return Ekind (Id) in Object_Kind; + end Is_Object; + + function Is_Ordinary_Fixed_Point_Type (Id : E) return B is + begin + return Ekind (Id) in Ordinary_Fixed_Point_Kind; + end Is_Ordinary_Fixed_Point_Type; + + function Is_Overloadable (Id : E) return B is + begin + return Ekind (Id) in Overloadable_Kind; + end Is_Overloadable; + + function Is_Private_Type (Id : E) return B is + begin + return Ekind (Id) in Private_Kind; + end Is_Private_Type; + + function Is_Protected_Type (Id : E) return B is + begin + return Ekind (Id) in Protected_Kind; + end Is_Protected_Type; + + function Is_Real_Type (Id : E) return B is + begin + return Ekind (Id) in Real_Kind; + end Is_Real_Type; + + function Is_Record_Type (Id : E) return B is + begin + return Ekind (Id) in Record_Kind; + end Is_Record_Type; + + function Is_Scalar_Type (Id : E) return B is + begin + return Ekind (Id) in Scalar_Kind; + end Is_Scalar_Type; + + function Is_Signed_Integer_Type (Id : E) return B is + begin + return Ekind (Id) in Signed_Integer_Kind; + end Is_Signed_Integer_Type; + + function Is_Subprogram (Id : E) return B is + begin + return Ekind (Id) in Subprogram_Kind; + end Is_Subprogram; + + function Is_Subprogram_Or_Entry (Id : E) return B is + begin + return Ekind (Id) in Subprogram_Kind + or else + Ekind (Id) in Entry_Kind; + end Is_Subprogram_Or_Entry; + + function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B is + begin + return Ekind (Id) in Subprogram_Kind + or else + Ekind (Id) in Generic_Subprogram_Kind; + end Is_Subprogram_Or_Generic_Subprogram; + + function Is_Task_Type (Id : E) return B is + begin + return Ekind (Id) in Task_Kind; + end Is_Task_Type; + + function Is_Type (Id : E) return B is + begin + return Ekind (Id) in Type_Kind; + end Is_Type; + + ----------------------------------- + -- Field Initialization Routines -- + ----------------------------------- + + procedure Init_Alignment (Id : E) is + begin + Set_Alignment (Id, Uint_0); + end Init_Alignment; + + procedure Init_Alignment (Id : E; V : Int) is + begin + Set_Alignment (Id, UI_From_Int (V)); + end Init_Alignment; + + procedure Init_Component_Bit_Offset (Id : E) is + begin + Set_Component_Bit_Offset (Id, No_Uint); + end Init_Component_Bit_Offset; + + procedure Init_Component_Bit_Offset (Id : E; V : Int) is + begin + Set_Component_Bit_Offset (Id, UI_From_Int (V)); + end Init_Component_Bit_Offset; + + procedure Init_Component_Size (Id : E) is + begin + Set_Component_Size (Id, Uint_0); + end Init_Component_Size; + + procedure Init_Component_Size (Id : E; V : Int) is + begin + Set_Component_Size (Id, UI_From_Int (V)); + end Init_Component_Size; + + procedure Init_Digits_Value (Id : E) is + begin + Set_Digits_Value (Id, Uint_0); + end Init_Digits_Value; + + procedure Init_Digits_Value (Id : E; V : Int) is + begin + Set_Digits_Value (Id, UI_From_Int (V)); + end Init_Digits_Value; + + procedure Init_Esize (Id : E) is + begin + Set_Esize (Id, Uint_0); + end Init_Esize; + + procedure Init_Esize (Id : E; V : Int) is + begin + Set_Esize (Id, UI_From_Int (V)); + end Init_Esize; + + procedure Init_Normalized_First_Bit (Id : E) is + begin + Set_Normalized_First_Bit (Id, No_Uint); + end Init_Normalized_First_Bit; + + procedure Init_Normalized_First_Bit (Id : E; V : Int) is + begin + Set_Normalized_First_Bit (Id, UI_From_Int (V)); + end Init_Normalized_First_Bit; + + procedure Init_Normalized_Position (Id : E) is + begin + Set_Normalized_Position (Id, No_Uint); + end Init_Normalized_Position; + + procedure Init_Normalized_Position (Id : E; V : Int) is + begin + Set_Normalized_Position (Id, UI_From_Int (V)); + end Init_Normalized_Position; + + procedure Init_Normalized_Position_Max (Id : E) is + begin + Set_Normalized_Position_Max (Id, No_Uint); + end Init_Normalized_Position_Max; + + procedure Init_Normalized_Position_Max (Id : E; V : Int) is + begin + Set_Normalized_Position_Max (Id, UI_From_Int (V)); + end Init_Normalized_Position_Max; + + procedure Init_RM_Size (Id : E) is + begin + Set_RM_Size (Id, Uint_0); + end Init_RM_Size; + + procedure Init_RM_Size (Id : E; V : Int) is + begin + Set_RM_Size (Id, UI_From_Int (V)); + end Init_RM_Size; + + ----------------------------- + -- Init_Component_Location -- + ----------------------------- + + procedure Init_Component_Location (Id : E) is + begin + Set_Normalized_First_Bit (Id, No_Uint); + Set_Normalized_Position_Max (Id, No_Uint); + Set_Component_Bit_Offset (Id, No_Uint); + Set_Esize (Id, Uint_0); + Set_Normalized_Position (Id, No_Uint); + end Init_Component_Location; + + ---------------------------- + -- Init_Object_Size_Align -- + ---------------------------- + + procedure Init_Object_Size_Align (Id : E) is + begin + Set_Esize (Id, Uint_0); + Set_Alignment (Id, Uint_0); + end Init_Object_Size_Align; + + --------------- + -- Init_Size -- + --------------- + + procedure Init_Size (Id : E; V : Int) is + begin + pragma Assert (not Is_Object (Id)); + Set_Esize (Id, UI_From_Int (V)); + Set_RM_Size (Id, UI_From_Int (V)); + end Init_Size; + + --------------------- + -- Init_Size_Align -- + --------------------- + + procedure Init_Size_Align (Id : E) is + begin + pragma Assert (not Is_Object (Id)); + Set_Esize (Id, Uint_0); + Set_RM_Size (Id, Uint_0); + Set_Alignment (Id, Uint_0); + end Init_Size_Align; + + ---------------------------------------------- + -- Type Representation Attribute Predicates -- + ---------------------------------------------- + + function Known_Alignment (E : Entity_Id) return B is + begin + return Alignment (E) /= Uint_0 + and then Alignment (E) /= No_Uint; + end Known_Alignment; + + function Known_Component_Bit_Offset (E : Entity_Id) return B is + begin + return Component_Bit_Offset (E) /= No_Uint; + end Known_Component_Bit_Offset; + + function Known_Component_Size (E : Entity_Id) return B is + begin + return Component_Size (Base_Type (E)) /= Uint_0 + and then Component_Size (Base_Type (E)) /= No_Uint; + end Known_Component_Size; + + function Known_Esize (E : Entity_Id) return B is + begin + return Esize (E) /= Uint_0 + and then Esize (E) /= No_Uint; + end Known_Esize; + + function Known_Normalized_First_Bit (E : Entity_Id) return B is + begin + return Normalized_First_Bit (E) /= No_Uint; + end Known_Normalized_First_Bit; + + function Known_Normalized_Position (E : Entity_Id) return B is + begin + return Normalized_Position (E) /= No_Uint; + end Known_Normalized_Position; + + function Known_Normalized_Position_Max (E : Entity_Id) return B is + begin + return Normalized_Position_Max (E) /= No_Uint; + end Known_Normalized_Position_Max; + + function Known_RM_Size (E : Entity_Id) return B is + begin + return RM_Size (E) /= No_Uint + and then (RM_Size (E) /= Uint_0 + or else Is_Discrete_Type (E) + or else Is_Fixed_Point_Type (E)); + end Known_RM_Size; + + function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is + begin + return Component_Bit_Offset (E) /= No_Uint + and then Component_Bit_Offset (E) >= Uint_0; + end Known_Static_Component_Bit_Offset; + + function Known_Static_Component_Size (E : Entity_Id) return B is + begin + return Component_Size (Base_Type (E)) > Uint_0; + end Known_Static_Component_Size; + + function Known_Static_Esize (E : Entity_Id) return B is + begin + return Esize (E) > Uint_0 + and then not Is_Generic_Type (E); + end Known_Static_Esize; + + function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is + begin + return Normalized_First_Bit (E) /= No_Uint + and then Normalized_First_Bit (E) >= Uint_0; + end Known_Static_Normalized_First_Bit; + + function Known_Static_Normalized_Position (E : Entity_Id) return B is + begin + return Normalized_Position (E) /= No_Uint + and then Normalized_Position (E) >= Uint_0; + end Known_Static_Normalized_Position; + + function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is + begin + return Normalized_Position_Max (E) /= No_Uint + and then Normalized_Position_Max (E) >= Uint_0; + end Known_Static_Normalized_Position_Max; + + function Known_Static_RM_Size (E : Entity_Id) return B is + begin + return (RM_Size (E) > Uint_0 + or else Is_Discrete_Type (E) + or else Is_Fixed_Point_Type (E)) + and then not Is_Generic_Type (E); + end Known_Static_RM_Size; + + function Unknown_Alignment (E : Entity_Id) return B is + begin + return Alignment (E) = Uint_0 + or else Alignment (E) = No_Uint; + end Unknown_Alignment; + + function Unknown_Component_Bit_Offset (E : Entity_Id) return B is + begin + return Component_Bit_Offset (E) = No_Uint; + end Unknown_Component_Bit_Offset; + + function Unknown_Component_Size (E : Entity_Id) return B is + begin + return Component_Size (Base_Type (E)) = Uint_0 + or else + Component_Size (Base_Type (E)) = No_Uint; + end Unknown_Component_Size; + + function Unknown_Esize (E : Entity_Id) return B is + begin + return Esize (E) = No_Uint + or else + Esize (E) = Uint_0; + end Unknown_Esize; + + function Unknown_Normalized_First_Bit (E : Entity_Id) return B is + begin + return Normalized_First_Bit (E) = No_Uint; + end Unknown_Normalized_First_Bit; + + function Unknown_Normalized_Position (E : Entity_Id) return B is + begin + return Normalized_Position (E) = No_Uint; + end Unknown_Normalized_Position; + + function Unknown_Normalized_Position_Max (E : Entity_Id) return B is + begin + return Normalized_Position_Max (E) = No_Uint; + end Unknown_Normalized_Position_Max; + + function Unknown_RM_Size (E : Entity_Id) return B is + begin + return (RM_Size (E) = Uint_0 + and then not Is_Discrete_Type (E) + and then not Is_Fixed_Point_Type (E)) + or else RM_Size (E) = No_Uint; + end Unknown_RM_Size; + + -------------------- + -- Address_Clause -- + -------------------- + + function Address_Clause (Id : E) return N is + begin + return Get_Attribute_Definition_Clause (Id, Attribute_Address); + end Address_Clause; + + --------------- + -- Aft_Value -- + --------------- + + function Aft_Value (Id : E) return U is + Result : Nat := 1; + Delta_Val : Ureal := Delta_Value (Id); + begin + while Delta_Val < Ureal_Tenth loop + Delta_Val := Delta_Val * Ureal_10; + Result := Result + 1; + end loop; + + return UI_From_Int (Result); + end Aft_Value; + + ---------------------- + -- Alignment_Clause -- + ---------------------- + + function Alignment_Clause (Id : E) return N is + begin + return Get_Attribute_Definition_Clause (Id, Attribute_Alignment); + end Alignment_Clause; + + ------------------- + -- Append_Entity -- + ------------------- + + procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id) is + Last : constant Entity_Id := Last_Entity (Scop); + + begin + Set_Scope (Id, Scop); + Set_Prev_Entity (Id, Empty); -- Empty <-- Id + + -- The entity chain is empty + + if No (Last) then + Set_First_Entity (Scop, Id); + + -- Otherwise the entity chain has at least one element + + else + Link_Entities (Last, Id); -- Last <-- Id, Last --> Id + end if; + + -- NOTE: The setting of the Next_Entity attribute of Id must happen + -- here as opposed to at the beginning of the routine because doing + -- so causes the binder to hang. It is not clear why ??? + + Set_Next_Entity (Id, Empty); -- Id --> Empty + + Set_Last_Entity (Scop, Id); + end Append_Entity; + + --------------- + -- Base_Type -- + --------------- + + function Base_Type (Id : E) return E is + begin + if Is_Base_Type (Id) then + return Id; + else + pragma Assert (Is_Type (Id)); + return Etype (Id); + end if; + end Base_Type; + + ---------------------- + -- Declaration_Node -- + ---------------------- + + function Declaration_Node (Id : E) return N is + P : Node_Id; + + begin + if Ekind (Id) = E_Incomplete_Type + and then Present (Full_View (Id)) + then + P := Parent (Full_View (Id)); + else + P := Parent (Id); + end if; + + loop + if Nkind (P) in N_Selected_Component | N_Expanded_Name + or else (Nkind (P) = N_Defining_Program_Unit_Name + and then Is_Child_Unit (Id)) + then + P := Parent (P); + else + return P; + end if; + end loop; + end Declaration_Node; + + --------------------- + -- Designated_Type -- + --------------------- + + function Designated_Type (Id : E) return E is + Desig_Type : Entity_Id; + + begin + Desig_Type := Directly_Designated_Type (Id); + + if No (Desig_Type) then + pragma Assert (Error_Posted (Id)); + return Any_Type; + end if; + + if Is_Incomplete_Type (Desig_Type) + and then Present (Full_View (Desig_Type)) + then + return Full_View (Desig_Type); + end if; + + if Is_Class_Wide_Type (Desig_Type) + and then Is_Incomplete_Type (Etype (Desig_Type)) + and then Present (Full_View (Etype (Desig_Type))) + and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type)))) + then + return Class_Wide_Type (Full_View (Etype (Desig_Type))); + end if; + + return Desig_Type; + end Designated_Type; + + ---------------------- + -- Entry_Index_Type -- + ---------------------- + + function Entry_Index_Type (Id : E) return N is + begin + pragma Assert (Ekind (Id) = E_Entry_Family); + return Etype (Discrete_Subtype_Definition (Parent (Id))); + end Entry_Index_Type; + + --------------------- + -- First_Component -- + --------------------- + + function First_Component (Id : E) return E is + Comp_Id : Entity_Id; + + begin + pragma Assert + (Is_Concurrent_Type (Id) + or else Is_Incomplete_Or_Private_Type (Id) + or else Is_Record_Type (Id)); + + Comp_Id := First_Entity (Id); + while Present (Comp_Id) loop + exit when Ekind (Comp_Id) = E_Component; + Next_Entity (Comp_Id); + end loop; + + return Comp_Id; + end First_Component; + + ------------------------------------- + -- First_Component_Or_Discriminant -- + ------------------------------------- + + function First_Component_Or_Discriminant (Id : E) return E is + Comp_Id : Entity_Id; + + begin + pragma Assert + (Is_Concurrent_Type (Id) + or else Is_Incomplete_Or_Private_Type (Id) + or else Is_Record_Type (Id) + or else Has_Discriminants (Id)); + + Comp_Id := First_Entity (Id); + while Present (Comp_Id) loop + exit when Ekind (Comp_Id) in E_Component | E_Discriminant; + Next_Entity (Comp_Id); + end loop; + + return Comp_Id; + end First_Component_Or_Discriminant; + + ------------------ + -- First_Formal -- + ------------------ + + function First_Formal (Id : E) return E is + Formal : Entity_Id; + + begin + pragma Assert + (Is_Generic_Subprogram (Id) + or else Is_Overloadable (Id) + or else Ekind (Id) in E_Entry_Family + | E_Subprogram_Body + | E_Subprogram_Type); + + if Ekind (Id) = E_Enumeration_Literal then + return Empty; + + else + Formal := First_Entity (Id); + + -- Deal with the common, non-generic case first + + if No (Formal) or else Is_Formal (Formal) then + return Formal; + end if; + + -- The first/next entity chain of a generic subprogram contains all + -- generic formal parameters, followed by the formal parameters. + + if Is_Generic_Subprogram (Id) then + while Present (Formal) and then not Is_Formal (Formal) loop + Next_Entity (Formal); + end loop; + return Formal; + else + return Empty; + end if; + end if; + end First_Formal; + + ------------------------------ + -- First_Formal_With_Extras -- + ------------------------------ + + function First_Formal_With_Extras (Id : E) return E is + Formal : Entity_Id; + + begin + pragma Assert + (Is_Generic_Subprogram (Id) + or else Is_Overloadable (Id) + or else Ekind (Id) in E_Entry_Family + | E_Subprogram_Body + | E_Subprogram_Type); + + if Ekind (Id) = E_Enumeration_Literal then + return Empty; + + else + Formal := First_Entity (Id); + + -- The first/next entity chain of a generic subprogram contains all + -- generic formal parameters, followed by the formal parameters. Go + -- directly to the parameters by skipping the formal part. + + if Is_Generic_Subprogram (Id) then + while Present (Formal) and then not Is_Formal (Formal) loop + Next_Entity (Formal); + end loop; + end if; + + if Present (Formal) and then Is_Formal (Formal) then + return Formal; + else + return Extra_Formals (Id); -- Empty if no extra formals + end if; + end if; + end First_Formal_With_Extras; + + ------------------------------------- + -- Get_Attribute_Definition_Clause -- + ------------------------------------- + + function Get_Attribute_Definition_Clause + (E : Entity_Id; + Id : Attribute_Id) return Node_Id + is + N : Node_Id; + + begin + N := First_Rep_Item (E); + while Present (N) loop + if Nkind (N) = N_Attribute_Definition_Clause + and then Get_Attribute_Id (Chars (N)) = Id + then + return N; + else + Next_Rep_Item (N); + end if; + end loop; + + return Empty; + end Get_Attribute_Definition_Clause; + + --------------------------- + -- Get_Class_Wide_Pragma -- + --------------------------- + + function Get_Class_Wide_Pragma + (E : Entity_Id; + Id : Pragma_Id) return Node_Id + is + Item : Node_Id; + Items : Node_Id; + + begin + Items := Contract (E); + + if No (Items) then + return Empty; + end if; + + Item := Pre_Post_Conditions (Items); + while Present (Item) loop + if Nkind (Item) = N_Pragma + and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id + and then Class_Present (Item) + then + return Item; + end if; + + Item := Next_Pragma (Item); + end loop; + + return Empty; + end Get_Class_Wide_Pragma; + + ------------------- + -- Get_Full_View -- + ------------------- + + function Get_Full_View (T : Entity_Id) return Entity_Id is + begin + if Is_Incomplete_Type (T) and then Present (Full_View (T)) then + return Full_View (T); + + elsif Is_Class_Wide_Type (T) + and then Is_Incomplete_Type (Root_Type (T)) + and then Present (Full_View (Root_Type (T))) + then + return Class_Wide_Type (Full_View (Root_Type (T))); + + else + return T; + end if; + end Get_Full_View; + + ---------------- + -- Get_Pragma -- + ---------------- + + function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is + + -- Classification pragmas + + Is_CLS : constant Boolean := + Id = Pragma_Abstract_State or else + Id = Pragma_Attach_Handler or else + Id = Pragma_Async_Readers or else + Id = Pragma_Async_Writers or else + Id = Pragma_Constant_After_Elaboration or else + Id = Pragma_Depends or else + Id = Pragma_Effective_Reads or else + Id = Pragma_Effective_Writes or else + Id = Pragma_Extensions_Visible or else + Id = Pragma_Global or else + Id = Pragma_Initial_Condition or else + Id = Pragma_Initializes or else + Id = Pragma_Interrupt_Handler or else + Id = Pragma_No_Caching or else + Id = Pragma_Part_Of or else + Id = Pragma_Refined_Depends or else + Id = Pragma_Refined_Global or else + Id = Pragma_Refined_State or else + Id = Pragma_Volatile_Function; + + -- Contract / subprogram variant / test case pragmas + + Is_CTC : constant Boolean := + Id = Pragma_Contract_Cases or else + Id = Pragma_Subprogram_Variant or else + Id = Pragma_Test_Case; + + -- Pre / postcondition pragmas + + Is_PPC : constant Boolean := + Id = Pragma_Precondition or else + Id = Pragma_Postcondition or else + Id = Pragma_Refined_Post; + + In_Contract : constant Boolean := Is_CLS or Is_CTC or Is_PPC; + + Item : Node_Id; + Items : Node_Id; + + begin + -- Handle pragmas that appear in N_Contract nodes. Those have to be + -- extracted from their specialized list. + + if In_Contract then + Items := Contract (E); + + if No (Items) then + return Empty; + + elsif Is_CLS then + Item := Classifications (Items); + + elsif Is_CTC then + Item := Contract_Test_Cases (Items); + + else + Item := Pre_Post_Conditions (Items); + end if; + + -- Regular pragmas + + else + Item := First_Rep_Item (E); + end if; + + while Present (Item) loop + if Nkind (Item) = N_Pragma + and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id + then + return Item; + + -- All nodes in N_Contract are chained using Next_Pragma + + elsif In_Contract then + Item := Next_Pragma (Item); + + -- Regular pragmas + + else + Next_Rep_Item (Item); + end if; + end loop; + + return Empty; + end Get_Pragma; + + -------------------------------------- + -- Get_Record_Representation_Clause -- + -------------------------------------- + + function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is + N : Node_Id; + + begin + N := First_Rep_Item (E); + while Present (N) loop + if Nkind (N) = N_Record_Representation_Clause then + return N; + end if; + + Next_Rep_Item (N); + end loop; + + return Empty; + end Get_Record_Representation_Clause; + + ------------------------ + -- Has_Attach_Handler -- + ------------------------ + + function Has_Attach_Handler (Id : E) return B is + Ritem : Node_Id; + + begin + pragma Assert (Is_Protected_Type (Id)); + + Ritem := First_Rep_Item (Id); + while Present (Ritem) loop + if Nkind (Ritem) = N_Pragma + and then Pragma_Name (Ritem) = Name_Attach_Handler + then + return True; + else + Next_Rep_Item (Ritem); + end if; + end loop; + + return False; + end Has_Attach_Handler; + + ------------- + -- Has_DIC -- + ------------- + + function Has_DIC (Id : E) return B is + begin + return Has_Own_DIC (Id) or else Has_Inherited_DIC (Id); + end Has_DIC; + + ----------------- + -- Has_Entries -- + ----------------- + + function Has_Entries (Id : E) return B is + Ent : Entity_Id; + + begin + pragma Assert (Is_Concurrent_Type (Id)); + + Ent := First_Entity (Id); + while Present (Ent) loop + if Is_Entry (Ent) then + return True; + end if; + + Next_Entity (Ent); + end loop; + + return False; + end Has_Entries; + + ---------------------------- + -- Has_Foreign_Convention -- + ---------------------------- + + function Has_Foreign_Convention (Id : E) return B is + begin + -- While regular Intrinsics such as the Standard operators fit in the + -- "Ada" convention, those with an Interface_Name materialize GCC + -- builtin imports for which Ada special treatments shouldn't apply. + + return Convention (Id) in Foreign_Convention + or else (Convention (Id) = Convention_Intrinsic + and then Present (Interface_Name (Id))); + end Has_Foreign_Convention; + + --------------------------- + -- Has_Interrupt_Handler -- + --------------------------- + + function Has_Interrupt_Handler (Id : E) return B is + Ritem : Node_Id; + + begin + pragma Assert (Is_Protected_Type (Id)); + + Ritem := First_Rep_Item (Id); + while Present (Ritem) loop + if Nkind (Ritem) = N_Pragma + and then Pragma_Name (Ritem) = Name_Interrupt_Handler + then + return True; + else + Next_Rep_Item (Ritem); + end if; + end loop; + + return False; + end Has_Interrupt_Handler; + + -------------------- + -- Has_Invariants -- + -------------------- + + function Has_Invariants (Id : E) return B is + begin + return Has_Own_Invariants (Id) or else Has_Inherited_Invariants (Id); + end Has_Invariants; + + -------------------------- + -- Has_Limited_View -- + -------------------------- + + function Has_Limited_View (Id : E) return B is + begin + return Ekind (Id) = E_Package + and then not Is_Generic_Instance (Id) + and then Present (Limited_View (Id)); + end Has_Limited_View; + + -------------------------- + -- Has_Non_Limited_View -- + -------------------------- + + function Has_Non_Limited_View (Id : E) return B is + begin + return (Ekind (Id) in Incomplete_Kind + or else Ekind (Id) in Class_Wide_Kind + or else Ekind (Id) = E_Abstract_State) + and then Present (Non_Limited_View (Id)); + end Has_Non_Limited_View; + + --------------------------------- + -- Has_Non_Null_Abstract_State -- + --------------------------------- + + function Has_Non_Null_Abstract_State (Id : E) return B is + begin + pragma Assert (Is_Package_Or_Generic_Package (Id)); + + return + Present (Abstract_States (Id)) + and then + not Is_Null_State (Node (First_Elmt (Abstract_States (Id)))); + end Has_Non_Null_Abstract_State; + + ------------------------------------- + -- Has_Non_Null_Visible_Refinement -- + ------------------------------------- + + function Has_Non_Null_Visible_Refinement (Id : E) return B is + Constits : Elist_Id; + + begin + -- "Refinement" is a concept applicable only to abstract states + + pragma Assert (Ekind (Id) = E_Abstract_State); + Constits := Refinement_Constituents (Id); + + -- A partial refinement is always non-null. For a full refinement to be + -- non-null, the first constituent must be anything other than null. + + return + Has_Partial_Visible_Refinement (Id) + or else (Has_Visible_Refinement (Id) + and then Present (Constits) + and then Nkind (Node (First_Elmt (Constits))) /= N_Null); + end Has_Non_Null_Visible_Refinement; + + ----------------------------- + -- Has_Null_Abstract_State -- + ----------------------------- + + function Has_Null_Abstract_State (Id : E) return B is + pragma Assert (Is_Package_Or_Generic_Package (Id)); + + States : constant Elist_Id := Abstract_States (Id); + + begin + -- Check first available state of related package. A null abstract + -- state always appears as the sole element of the state list. + + return + Present (States) + and then Is_Null_State (Node (First_Elmt (States))); + end Has_Null_Abstract_State; + + --------------------------------- + -- Has_Null_Visible_Refinement -- + --------------------------------- + + function Has_Null_Visible_Refinement (Id : E) return B is + Constits : Elist_Id; + + begin + -- "Refinement" is a concept applicable only to abstract states + + pragma Assert (Ekind (Id) = E_Abstract_State); + Constits := Refinement_Constituents (Id); + + -- For a refinement to be null, the state's sole constituent must be a + -- null. + + return + Has_Visible_Refinement (Id) + and then Present (Constits) + and then Nkind (Node (First_Elmt (Constits))) = N_Null; + end Has_Null_Visible_Refinement; + + -------------------- + -- Has_Unmodified -- + -------------------- + + function Has_Unmodified (E : Entity_Id) return Boolean is + begin + if Has_Pragma_Unmodified (E) then + return True; + elsif Warnings_Off (E) then + Set_Warnings_Off_Used_Unmodified (E); + return True; + else + return False; + end if; + end Has_Unmodified; + + --------------------- + -- Has_Unreferenced -- + --------------------- + + function Has_Unreferenced (E : Entity_Id) return Boolean is + begin + if Has_Pragma_Unreferenced (E) then + return True; + elsif Warnings_Off (E) then + Set_Warnings_Off_Used_Unreferenced (E); + return True; + else + return False; + end if; + end Has_Unreferenced; + + ---------------------- + -- Has_Warnings_Off -- + ---------------------- + + function Has_Warnings_Off (E : Entity_Id) return Boolean is + begin + if Warnings_Off (E) then + Set_Warnings_Off_Used (E); + return True; + else + return False; + end if; + end Has_Warnings_Off; + + ------------------------------ + -- Implementation_Base_Type -- + ------------------------------ + + function Implementation_Base_Type (Id : E) return E is + Bastyp : Entity_Id; + Imptyp : Entity_Id; + + begin + Bastyp := Base_Type (Id); + + if Is_Incomplete_Or_Private_Type (Bastyp) then + Imptyp := Underlying_Type (Bastyp); + + -- If we have an implementation type, then just return it, + -- otherwise we return the Base_Type anyway. This can only + -- happen in error situations and should avoid some error bombs. + + if Present (Imptyp) then + return Base_Type (Imptyp); + else + return Bastyp; + end if; + + else + return Bastyp; + end if; + end Implementation_Base_Type; + + ------------------------- + -- Invariant_Procedure -- + ------------------------- + + function Invariant_Procedure (Id : E) return E is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id)); + + Subps := Subprograms_For_Type (Base_Type (Id)); + + if Present (Subps) then + Subp_Elmt := First_Elmt (Subps); + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Is_Invariant_Procedure (Subp_Id) then + return Subp_Id; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end if; + + return Empty; + end Invariant_Procedure; + + ------------------ + -- Is_Base_Type -- + ------------------ + + -- Global flag table allowing rapid computation of this function + + Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean := + (E_Enumeration_Subtype | + E_Incomplete_Subtype | + E_Signed_Integer_Subtype | + E_Modular_Integer_Subtype | + E_Floating_Point_Subtype | + E_Ordinary_Fixed_Point_Subtype | + E_Decimal_Fixed_Point_Subtype | + E_Array_Subtype | + E_Record_Subtype | + E_Private_Subtype | + E_Record_Subtype_With_Private | + E_Limited_Private_Subtype | + E_Access_Subtype | + E_Protected_Subtype | + E_Task_Subtype | + E_String_Literal_Subtype | + E_Class_Wide_Subtype => False, + others => True); + + function Is_Base_Type (Id : E) return Boolean is + begin +-- ???? pragma Assert (Is_Type (Id)); +-- Apparently, Is_Base_Type is called on non-types, and returns True! + return Entity_Is_Base_Type (Ekind (Id)); + end Is_Base_Type; + + --------------------- + -- Is_Boolean_Type -- + --------------------- + + function Is_Boolean_Type (Id : E) return B is + begin + return Root_Type (Id) = Standard_Boolean; + end Is_Boolean_Type; + + ------------------------ + -- Is_Constant_Object -- + ------------------------ + + function Is_Constant_Object (Id : E) return B is + begin + return Ekind (Id) in E_Constant | E_In_Parameter | E_Loop_Parameter; + end Is_Constant_Object; + + ------------------- + -- Is_Controlled -- + ------------------- + + function Is_Controlled (Id : E) return B is + begin + return Is_Controlled_Active (Id) and then not Disable_Controlled (Id); + end Is_Controlled; + + -------------------- + -- Is_Discriminal -- + -------------------- + + function Is_Discriminal (Id : E) return B is + begin + return Ekind (Id) in E_Constant | E_In_Parameter + and then Present (Discriminal_Link (Id)); + end Is_Discriminal; + + ---------------------- + -- Is_Dynamic_Scope -- + ---------------------- + + function Is_Dynamic_Scope (Id : E) return B is + begin + return + Ekind (Id) = E_Block + or else + Ekind (Id) = E_Function + or else + Ekind (Id) = E_Procedure + or else + Ekind (Id) = E_Subprogram_Body + or else + Ekind (Id) = E_Task_Type + or else + (Ekind (Id) = E_Limited_Private_Type + and then Present (Full_View (Id)) + and then Ekind (Full_View (Id)) = E_Task_Type) + or else + Ekind (Id) = E_Entry + or else + Ekind (Id) = E_Entry_Family + or else + Ekind (Id) = E_Return_Statement; + end Is_Dynamic_Scope; + + -------------------- + -- Is_Entity_Name -- + -------------------- + + function Is_Entity_Name (N : Node_Id) return Boolean is + Kind : constant Node_Kind := Nkind (N); + + begin + -- Identifiers, operator symbols, expanded names are entity names + + return Kind = N_Identifier + or else Kind = N_Operator_Symbol + or else Kind = N_Expanded_Name + + -- Attribute references are entity names if they refer to an entity. + -- Note that we don't do this by testing for the presence of the + -- Entity field in the N_Attribute_Reference node, since it may not + -- have been set yet. + + or else (Kind = N_Attribute_Reference + and then Is_Entity_Attribute_Name (Attribute_Name (N))); + end Is_Entity_Name; + + --------------------------- + -- Is_Elaboration_Target -- + --------------------------- + + function Is_Elaboration_Target (Id : Entity_Id) return Boolean is + begin + return + Ekind (Id) in E_Constant | E_Package | E_Variable + or else Is_Entry (Id) + or else Is_Generic_Unit (Id) + or else Is_Subprogram (Id) + or else Is_Task_Type (Id); + end Is_Elaboration_Target; + + ----------------------- + -- Is_External_State -- + ----------------------- + + function Is_External_State (Id : E) return B is + begin + -- To qualify, the abstract state must appear with option "external" or + -- "synchronous" (SPARK RM 7.1.4(7) and (9)). + + return + Ekind (Id) = E_Abstract_State + and then (Has_Option (Id, Name_External) + or else + Has_Option (Id, Name_Synchronous)); + end Is_External_State; + + ------------------ + -- Is_Finalizer -- + ------------------ + + function Is_Finalizer (Id : E) return B is + begin + return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer; + end Is_Finalizer; + + ---------------------- + -- Is_Full_Access -- + ---------------------- + + function Is_Full_Access (Id : E) return B is + begin + return Is_Atomic (Id) or else Is_Volatile_Full_Access (Id); + end Is_Full_Access; + + ------------------- + -- Is_Null_State -- + ------------------- + + function Is_Null_State (Id : E) return B is + begin + return + Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null; + end Is_Null_State; + + ----------------------------------- + -- Is_Package_Or_Generic_Package -- + ----------------------------------- + + function Is_Package_Or_Generic_Package (Id : E) return B is + begin + return Ekind (Id) in E_Generic_Package | E_Package; + end Is_Package_Or_Generic_Package; + + --------------------- + -- Is_Packed_Array -- + --------------------- + + function Is_Packed_Array (Id : E) return B is + begin + return Is_Array_Type (Id) and then Is_Packed (Id); + end Is_Packed_Array; + + --------------- + -- Is_Prival -- + --------------- + + function Is_Prival (Id : E) return B is + begin + return Ekind (Id) in E_Constant | E_Variable + and then Present (Prival_Link (Id)); + end Is_Prival; + + ---------------------------- + -- Is_Protected_Component -- + ---------------------------- + + function Is_Protected_Component (Id : E) return B is + begin + return Ekind (Id) = E_Component and then Is_Protected_Type (Scope (Id)); + end Is_Protected_Component; + + ---------------------------- + -- Is_Protected_Interface -- + ---------------------------- + + function Is_Protected_Interface (Id : E) return B is + Typ : constant Entity_Id := Base_Type (Id); + begin + if not Is_Interface (Typ) then + return False; + elsif Is_Class_Wide_Type (Typ) then + return Is_Protected_Interface (Etype (Typ)); + else + return Protected_Present (Type_Definition (Parent (Typ))); + end if; + end Is_Protected_Interface; + + ------------------------------ + -- Is_Protected_Record_Type -- + ------------------------------ + + function Is_Protected_Record_Type (Id : E) return B is + begin + return + Is_Concurrent_Record_Type (Id) + and then Is_Protected_Type (Corresponding_Concurrent_Type (Id)); + end Is_Protected_Record_Type; + + ------------------------------------- + -- Is_Relaxed_Initialization_State -- + ------------------------------------- + + function Is_Relaxed_Initialization_State (Id : E) return B is + begin + -- To qualify, the abstract state must appear with simple option + -- "Relaxed_Initialization" (SPARK RM 6.10). + + return + Ekind (Id) = E_Abstract_State + and then Has_Option (Id, Name_Relaxed_Initialization); + end Is_Relaxed_Initialization_State; + + -------------------------------- + -- Is_Standard_Character_Type -- + -------------------------------- + + function Is_Standard_Character_Type (Id : E) return B is + begin + return Is_Type (Id) + and then Root_Type (Id) in Standard_Character + | Standard_Wide_Character + | Standard_Wide_Wide_Character; + end Is_Standard_Character_Type; + + ----------------------------- + -- Is_Standard_String_Type -- + ----------------------------- + + function Is_Standard_String_Type (Id : E) return B is + begin + return Is_Type (Id) + and then Root_Type (Id) in Standard_String + | Standard_Wide_String + | Standard_Wide_Wide_String; + end Is_Standard_String_Type; + + -------------------- + -- Is_String_Type -- + -------------------- + + function Is_String_Type (Id : E) return B is + begin + return Is_Array_Type (Id) + and then Id /= Any_Composite + and then Number_Dimensions (Id) = 1 + and then Is_Character_Type (Component_Type (Id)); + end Is_String_Type; + + ------------------------------- + -- Is_Synchronized_Interface -- + ------------------------------- + + function Is_Synchronized_Interface (Id : E) return B is + Typ : constant Entity_Id := Base_Type (Id); + + begin + if not Is_Interface (Typ) then + return False; + + elsif Is_Class_Wide_Type (Typ) then + return Is_Synchronized_Interface (Etype (Typ)); + + else + return Protected_Present (Type_Definition (Parent (Typ))) + or else Synchronized_Present (Type_Definition (Parent (Typ))) + or else Task_Present (Type_Definition (Parent (Typ))); + end if; + end Is_Synchronized_Interface; + + --------------------------- + -- Is_Synchronized_State -- + --------------------------- + + function Is_Synchronized_State (Id : E) return B is + begin + -- To qualify, the abstract state must appear with simple option + -- "synchronous" (SPARK RM 7.1.4(9)). + + return + Ekind (Id) = E_Abstract_State + and then Has_Option (Id, Name_Synchronous); + end Is_Synchronized_State; + + ----------------------- + -- Is_Task_Interface -- + ----------------------- + + function Is_Task_Interface (Id : E) return B is + Typ : constant Entity_Id := Base_Type (Id); + begin + if not Is_Interface (Typ) then + return False; + elsif Is_Class_Wide_Type (Typ) then + return Is_Task_Interface (Etype (Typ)); + else + return Task_Present (Type_Definition (Parent (Typ))); + end if; + end Is_Task_Interface; + + ------------------------- + -- Is_Task_Record_Type -- + ------------------------- + + function Is_Task_Record_Type (Id : E) return B is + begin + return + Is_Concurrent_Record_Type (Id) + and then Is_Task_Type (Corresponding_Concurrent_Type (Id)); + end Is_Task_Record_Type; + + ------------------------ + -- Is_Wrapper_Package -- + ------------------------ + + function Is_Wrapper_Package (Id : E) return B is + begin + return Ekind (Id) = E_Package and then Present (Related_Instance (Id)); + end Is_Wrapper_Package; + + ----------------- + -- Last_Formal -- + ----------------- + + function Last_Formal (Id : E) return E is + Formal : Entity_Id; + + begin + pragma Assert + (Is_Overloadable (Id) + or else Ekind (Id) in E_Entry_Family + | E_Subprogram_Body + | E_Subprogram_Type); + + if Ekind (Id) = E_Enumeration_Literal then + return Empty; + + else + Formal := First_Formal (Id); + + if Present (Formal) then + while Present (Next_Formal (Formal)) loop + Next_Formal (Formal); + end loop; + end if; + + return Formal; + end if; + end Last_Formal; + + ------------------- + -- Link_Entities -- + ------------------- + + procedure Link_Entities (First : Entity_Id; Second : Node_Id) is + begin + if Present (Second) then + Set_Prev_Entity (Second, First); -- First <-- Second + end if; + + Set_Next_Entity (First, Second); -- First --> Second + end Link_Entities; + + ------------------------ + -- Machine_Emax_Value -- + ------------------------ + + function Machine_Emax_Value (Id : E) return Uint is + Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id))); + + begin + case Float_Rep (Id) is + when IEEE_Binary => + case Digs is + when 1 .. 6 => return Uint_128; + when 7 .. 15 => return 2**10; + when 16 .. 33 => return 2**14; + when others => return No_Uint; + end case; + + when AAMP => + return Uint_2 ** Uint_7 - Uint_1; + end case; + end Machine_Emax_Value; + + ------------------------ + -- Machine_Emin_Value -- + ------------------------ + + function Machine_Emin_Value (Id : E) return Uint is + begin + case Float_Rep (Id) is + when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id); + when AAMP => return -Machine_Emax_Value (Id); + end case; + end Machine_Emin_Value; + + ---------------------------- + -- Machine_Mantissa_Value -- + ---------------------------- + + function Machine_Mantissa_Value (Id : E) return Uint is + Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id))); + + begin + case Float_Rep (Id) is + when IEEE_Binary => + case Digs is + when 1 .. 6 => return Uint_24; + when 7 .. 15 => return UI_From_Int (53); + when 16 .. 18 => return Uint_64; + when 19 .. 33 => return UI_From_Int (113); + when others => return No_Uint; + end case; + + when AAMP => + case Digs is + when 1 .. 6 => return Uint_24; + when 7 .. 9 => return UI_From_Int (40); + when others => return No_Uint; + end case; + end case; + end Machine_Mantissa_Value; + + ------------------------- + -- Machine_Radix_Value -- + ------------------------- + + function Machine_Radix_Value (Id : E) return U is + begin + case Float_Rep (Id) is + when AAMP + | IEEE_Binary + => + return Uint_2; + end case; + end Machine_Radix_Value; + + ---------------------- + -- Model_Emin_Value -- + ---------------------- + + function Model_Emin_Value (Id : E) return Uint is + begin + return Machine_Emin_Value (Id); + end Model_Emin_Value; + + ------------------------- + -- Model_Epsilon_Value -- + ------------------------- + + function Model_Epsilon_Value (Id : E) return Ureal is + Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); + begin + return Radix ** (1 - Model_Mantissa_Value (Id)); + end Model_Epsilon_Value; + + -------------------------- + -- Model_Mantissa_Value -- + -------------------------- + + function Model_Mantissa_Value (Id : E) return Uint is + begin + return Machine_Mantissa_Value (Id); + end Model_Mantissa_Value; + + ----------------------- + -- Model_Small_Value -- + ----------------------- + + function Model_Small_Value (Id : E) return Ureal is + Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); + begin + return Radix ** (Model_Emin_Value (Id) - 1); + end Model_Small_Value; + + -------------------- + -- Next_Component -- + -------------------- + + function Next_Component (Id : E) return E is + Comp_Id : Entity_Id; + + begin + Comp_Id := Next_Entity (Id); + while Present (Comp_Id) loop + exit when Ekind (Comp_Id) = E_Component; + Next_Entity (Comp_Id); + end loop; + + return Comp_Id; + end Next_Component; + + ------------------------------------ + -- Next_Component_Or_Discriminant -- + ------------------------------------ + + function Next_Component_Or_Discriminant (Id : E) return E is + Comp_Id : Entity_Id; + + begin + Comp_Id := Next_Entity (Id); + while Present (Comp_Id) loop + exit when Ekind (Comp_Id) in E_Component | E_Discriminant; + Next_Entity (Comp_Id); + end loop; + + return Comp_Id; + end Next_Component_Or_Discriminant; + + ----------------------- + -- Next_Discriminant -- + ----------------------- + + -- This function actually implements both Next_Discriminant and + -- Next_Stored_Discriminant by making sure that the Discriminant + -- returned is of the same variety as Id. + + function Next_Discriminant (Id : E) return E is + + -- Derived Tagged types with private extensions look like this... + + -- E_Discriminant d1 + -- E_Discriminant d2 + -- E_Component _tag + -- E_Discriminant d1 + -- E_Discriminant d2 + -- ... + + -- so it is critical not to go past the leading discriminants + + D : E := Id; + + begin + pragma Assert (Ekind (Id) = E_Discriminant); + + loop + Next_Entity (D); + if No (D) + or else (Ekind (D) /= E_Discriminant + and then not Is_Itype (D)) + then + return Empty; + end if; + + exit when Ekind (D) = E_Discriminant + and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id)); + end loop; + + return D; + end Next_Discriminant; + + ----------------- + -- Next_Formal -- + ----------------- + + function Next_Formal (Id : E) return E is + P : Entity_Id; + + begin + -- Follow the chain of declared entities as long as the kind of the + -- entity corresponds to a formal parameter. Skip internal entities + -- that may have been created for implicit subtypes, in the process + -- of analyzing default expressions. + + P := Id; + loop + Next_Entity (P); + + if No (P) or else Is_Formal (P) then + return P; + elsif not Is_Internal (P) then + return Empty; + end if; + end loop; + end Next_Formal; + + ----------------------------- + -- Next_Formal_With_Extras -- + ----------------------------- + + function Next_Formal_With_Extras (Id : E) return E is + begin + if Present (Extra_Formal (Id)) then + return Extra_Formal (Id); + else + return Next_Formal (Id); + end if; + end Next_Formal_With_Extras; + + ---------------- + -- Next_Index -- + ---------------- + + function Next_Index (Id : Node_Id) return Node_Id is + begin + return Next (Id); + end Next_Index; + + ------------------ + -- Next_Literal -- + ------------------ + + function Next_Literal (Id : E) return E is + begin + pragma Assert (Nkind (Id) in N_Entity); + return Next (Id); + end Next_Literal; + + ------------------------------ + -- Next_Stored_Discriminant -- + ------------------------------ + + function Next_Stored_Discriminant (Id : E) return E is + begin + -- See comment in Next_Discriminant + + return Next_Discriminant (Id); + end Next_Stored_Discriminant; + + ----------------------- + -- Number_Dimensions -- + ----------------------- + + function Number_Dimensions (Id : E) return Pos is + N : Int; + T : Node_Id; + + begin + if Ekind (Id) = E_String_Literal_Subtype then + return 1; + + else + N := 0; + T := First_Index (Id); + while Present (T) loop + N := N + 1; + Next_Index (T); + end loop; + + return N; + end if; + end Number_Dimensions; + + -------------------- + -- Number_Entries -- + -------------------- + + function Number_Entries (Id : E) return Nat is + N : Int; + Ent : Entity_Id; + + begin + pragma Assert (Is_Concurrent_Type (Id)); + + N := 0; + Ent := First_Entity (Id); + while Present (Ent) loop + if Is_Entry (Ent) then + N := N + 1; + end if; + + Next_Entity (Ent); + end loop; + + return N; + end Number_Entries; + + -------------------- + -- Number_Formals -- + -------------------- + + function Number_Formals (Id : E) return Pos is + N : Int; + Formal : Entity_Id; + + begin + N := 0; + Formal := First_Formal (Id); + while Present (Formal) loop + N := N + 1; + Next_Formal (Formal); + end loop; + + return N; + end Number_Formals; + + ------------------------ + -- Object_Size_Clause -- + ------------------------ + + function Object_Size_Clause (Id : E) return N is + begin + return Get_Attribute_Definition_Clause (Id, Attribute_Object_Size); + end Object_Size_Clause; + + -------------------- + -- Parameter_Mode -- + -------------------- + + function Parameter_Mode (Id : E) return Formal_Kind is + begin + return Ekind (Id); + end Parameter_Mode; + + ------------------- + -- DIC_Procedure -- + ------------------- + + function DIC_Procedure (Id : E) return E is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id)); + + Subps := Subprograms_For_Type (Base_Type (Id)); + + if Present (Subps) then + Subp_Elmt := First_Elmt (Subps); + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + -- Currently the flag Is_DIC_Procedure is set for both normal DIC + -- check procedures as well as for partial DIC check procedures, + -- and we don't have a flag for the partial procedures. + + if Is_DIC_Procedure (Subp_Id) + and then not Is_Partial_DIC_Procedure (Subp_Id) + then + return Subp_Id; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end if; + + return Empty; + end DIC_Procedure; + + function Partial_DIC_Procedure (Id : E) return E is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id)); + + Subps := Subprograms_For_Type (Base_Type (Id)); + + if Present (Subps) then + Subp_Elmt := First_Elmt (Subps); + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Is_Partial_DIC_Procedure (Subp_Id) then + return Subp_Id; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end if; + + return Empty; + end Partial_DIC_Procedure; + + function Is_Partial_DIC_Procedure (Id : E) return B is + Partial_DIC_Suffix : constant String := "Partial_DIC"; + DIC_Nam : constant String := Get_Name_String (Chars (Id)); + + begin + pragma Assert (Ekind (Id) in E_Function | E_Procedure); + + -- Instead of adding a new Entity_Id flag (which are in short supply), + -- we test the form of the subprogram name. When the node field and flag + -- situation is eased, this should be replaced with a flag. ??? + + if DIC_Nam'Length > Partial_DIC_Suffix'Length + and then + DIC_Nam + (DIC_Nam'Last - Partial_DIC_Suffix'Length + 1 .. DIC_Nam'Last) = + Partial_DIC_Suffix + then + return True; + else + return False; + end if; + end Is_Partial_DIC_Procedure; + + --------------------------------- + -- Partial_Invariant_Procedure -- + --------------------------------- + + function Partial_Invariant_Procedure (Id : E) return E is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id)); + + Subps := Subprograms_For_Type (Base_Type (Id)); + + if Present (Subps) then + Subp_Elmt := First_Elmt (Subps); + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Is_Partial_Invariant_Procedure (Subp_Id) then + return Subp_Id; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end if; + + return Empty; + end Partial_Invariant_Procedure; + + ------------------------------------- + -- Partial_Refinement_Constituents -- + ------------------------------------- + + function Partial_Refinement_Constituents (Id : E) return L is + Constits : Elist_Id := No_Elist; + + procedure Add_Usable_Constituents (Item : E); + -- Add global item Item and/or its constituents to list Constits when + -- they can be used in a global refinement within the current scope. The + -- criteria are: + -- 1) If Item is an abstract state with full refinement visible, add + -- its constituents. + -- 2) If Item is an abstract state with only partial refinement + -- visible, add both Item and its constituents. + -- 3) If Item is an abstract state without a visible refinement, add + -- it. + -- 4) If Id is not an abstract state, add it. + + procedure Add_Usable_Constituents (List : Elist_Id); + -- Apply Add_Usable_Constituents to every constituent in List + + ----------------------------- + -- Add_Usable_Constituents -- + ----------------------------- + + procedure Add_Usable_Constituents (Item : E) is + begin + if Ekind (Item) = E_Abstract_State then + if Has_Visible_Refinement (Item) then + Add_Usable_Constituents (Refinement_Constituents (Item)); + + elsif Has_Partial_Visible_Refinement (Item) then + Append_New_Elmt (Item, Constits); + Add_Usable_Constituents (Part_Of_Constituents (Item)); + + else + Append_New_Elmt (Item, Constits); + end if; + + else + Append_New_Elmt (Item, Constits); + end if; + end Add_Usable_Constituents; + + procedure Add_Usable_Constituents (List : Elist_Id) is + Constit_Elmt : Elmt_Id; + begin + if Present (List) then + Constit_Elmt := First_Elmt (List); + while Present (Constit_Elmt) loop + Add_Usable_Constituents (Node (Constit_Elmt)); + Next_Elmt (Constit_Elmt); + end loop; + end if; + end Add_Usable_Constituents; + + -- Start of processing for Partial_Refinement_Constituents + + begin + -- "Refinement" is a concept applicable only to abstract states + + pragma Assert (Ekind (Id) = E_Abstract_State); + + if Has_Visible_Refinement (Id) then + Constits := Refinement_Constituents (Id); + + -- A refinement may be partially visible when objects declared in the + -- private part of a package are subject to a Part_Of indicator. + + elsif Has_Partial_Visible_Refinement (Id) then + Add_Usable_Constituents (Part_Of_Constituents (Id)); + + -- Function should only be called when full or partial refinement is + -- visible. + + else + raise Program_Error; + end if; + + return Constits; + end Partial_Refinement_Constituents; + + ------------------------ + -- Predicate_Function -- + ------------------------ + + function Predicate_Function (Id : E) return E is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + Typ : Entity_Id; + + begin + pragma Assert (Is_Type (Id)); + + -- If type is private and has a completion, predicate may be defined on + -- the full view. + + if Is_Private_Type (Id) + and then + (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id))) + and then Present (Full_View (Id)) + then + Typ := Full_View (Id); + + elsif Ekind (Id) in E_Array_Subtype + | E_Record_Subtype + | E_Record_Subtype_With_Private + and then Present (Predicated_Parent (Id)) + then + Typ := Predicated_Parent (Id); + + else + Typ := Id; + end if; + + Subps := Subprograms_For_Type (Typ); + + if Present (Subps) then + Subp_Elmt := First_Elmt (Subps); + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Ekind (Subp_Id) = E_Function + and then Is_Predicate_Function (Subp_Id) + then + return Subp_Id; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end if; + + return Empty; + end Predicate_Function; + + -------------------------- + -- Predicate_Function_M -- + -------------------------- + + function Predicate_Function_M (Id : E) return E is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + Typ : Entity_Id; + + begin + pragma Assert (Is_Type (Id)); + + -- If type is private and has a completion, predicate may be defined on + -- the full view. + + if Is_Private_Type (Id) + and then + (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id))) + and then Present (Full_View (Id)) + then + Typ := Full_View (Id); + + else + Typ := Id; + end if; + + Subps := Subprograms_For_Type (Typ); + + if Present (Subps) then + Subp_Elmt := First_Elmt (Subps); + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Ekind (Subp_Id) = E_Function + and then Is_Predicate_Function_M (Subp_Id) + then + return Subp_Id; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end if; + + return Empty; + end Predicate_Function_M; + + ------------------------- + -- Present_In_Rep_Item -- + ------------------------- + + function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean is + Ritem : Node_Id; + + begin + Ritem := First_Rep_Item (E); + + while Present (Ritem) loop + if Ritem = N then + return True; + end if; + + Next_Rep_Item (Ritem); + end loop; + + return False; + end Present_In_Rep_Item; + + -------------------------- + -- Primitive_Operations -- + -------------------------- + + function Primitive_Operations (Id : E) return L is + begin + if Is_Concurrent_Type (Id) then + if Present (Corresponding_Record_Type (Id)) then + return Direct_Primitive_Operations + (Corresponding_Record_Type (Id)); + + -- If expansion is disabled the corresponding record type is absent, + -- but if the type has ancestors it may have primitive operations. + + elsif Is_Tagged_Type (Id) then + return Direct_Primitive_Operations (Id); + + else + return No_Elist; + end if; + else + return Direct_Primitive_Operations (Id); + end if; + end Primitive_Operations; + + --------------------- + -- Record_Rep_Item -- + --------------------- + + procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is + begin + Set_Next_Rep_Item (N, First_Rep_Item (E)); + Set_First_Rep_Item (E, N); + end Record_Rep_Item; + + ------------------- + -- Remove_Entity -- + ------------------- + + procedure Remove_Entity (Id : Entity_Id) is + Next : constant Entity_Id := Next_Entity (Id); + Prev : constant Entity_Id := Prev_Entity (Id); + Scop : constant Entity_Id := Scope (Id); + First : constant Entity_Id := First_Entity (Scop); + Last : constant Entity_Id := Last_Entity (Scop); + + begin + -- Eliminate any existing linkages from the entity + + Set_Prev_Entity (Id, Empty); -- Empty <-- Id + Set_Next_Entity (Id, Empty); -- Id --> Empty + + -- The eliminated entity was the only element in the entity chain + + if Id = First and then Id = Last then + Set_First_Entity (Scop, Empty); + Set_Last_Entity (Scop, Empty); + + -- The eliminated entity was the head of the entity chain + + elsif Id = First then + Set_First_Entity (Scop, Next); + + -- The eliminated entity was the tail of the entity chain + + elsif Id = Last then + Set_Last_Entity (Scop, Prev); + + -- Otherwise the eliminated entity comes from the middle of the entity + -- chain. + + else + Link_Entities (Prev, Next); -- Prev <-- Next, Prev --> Next + end if; + end Remove_Entity; + + --------------- + -- Root_Type -- + --------------- + + function Root_Type (Id : E) return E is + T, Etyp : Entity_Id; + + begin + pragma Assert (Nkind (Id) in N_Entity); + + T := Base_Type (Id); + + if Ekind (T) = E_Class_Wide_Type then + return Etype (T); + + -- Other cases + + else + loop + Etyp := Etype (T); + + if T = Etyp then + return T; + + -- Following test catches some error cases resulting from + -- previous errors. + + elsif No (Etyp) then + Check_Error_Detected; + return T; + + elsif Is_Private_Type (T) and then Etyp = Full_View (T) then + return T; + + elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then + return T; + end if; + + T := Etyp; + + -- Return if there is a circularity in the inheritance chain. This + -- happens in some error situations and we do not want to get + -- stuck in this loop. + + if T = Base_Type (Id) then + return T; + end if; + end loop; + end if; + end Root_Type; + + --------------------- + -- Safe_Emax_Value -- + --------------------- + + function Safe_Emax_Value (Id : E) return Uint is + begin + return Machine_Emax_Value (Id); + end Safe_Emax_Value; + + ---------------------- + -- Safe_First_Value -- + ---------------------- + + function Safe_First_Value (Id : E) return Ureal is + begin + return -Safe_Last_Value (Id); + end Safe_First_Value; + + --------------------- + -- Safe_Last_Value -- + --------------------- + + function Safe_Last_Value (Id : E) return Ureal is + Radix : constant Uint := Machine_Radix_Value (Id); + Mantissa : constant Uint := Machine_Mantissa_Value (Id); + Emax : constant Uint := Safe_Emax_Value (Id); + Significand : constant Uint := Radix ** Mantissa - 1; + Exponent : constant Uint := Emax - Mantissa; + + begin + if Radix = 2 then + return + UR_From_Components + (Num => Significand * 2 ** (Exponent mod 4), + Den => -Exponent / 4, + Rbase => 16); + else + return + UR_From_Components + (Num => Significand, + Den => -Exponent, + Rbase => 16); + end if; + end Safe_Last_Value; + + ----------------- + -- Scope_Depth -- + ----------------- + + function Scope_Depth (Id : E) return Uint is + Scop : Entity_Id; + + begin + Scop := Id; + while Is_Record_Type (Scop) loop + Scop := Scope (Scop); + end loop; + + return Scope_Depth_Value (Scop); + end Scope_Depth; + + --------------------- + -- Scope_Depth_Set -- + --------------------- + + function Scope_Depth_Set (Id : E) return B is + begin + return not Is_Record_Type (Id) + and then not Field_Is_Initial_Zero (Id, Scope_Depth_Value); + -- We can't call Scope_Depth_Value here, because Empty is not a valid + -- value of type Uint. + end Scope_Depth_Set; + + -------------------- + -- Set_Convention -- + -------------------- + + procedure Set_Convention (E : Entity_Id; Val : Snames.Convention_Id) is + begin + Set_Basic_Convention (E, Val); + + if Is_Type (E) + and then Is_Access_Subprogram_Type (Base_Type (E)) + and then Has_Foreign_Convention (E) + then + Set_Can_Use_Internal_Rep (E, False); + end if; + + -- If E is an object, including a component, and the type of E is an + -- anonymous access type with no convention set, then also set the + -- convention of the anonymous access type. We do not do this for + -- anonymous protected types, since protected types always have the + -- default convention. + + if Present (Etype (E)) + and then (Is_Object (E) + + -- Allow E_Void (happens for pragma Convention appearing + -- in the middle of a record applying to a component) + + or else Ekind (E) = E_Void) + then + declare + Typ : constant Entity_Id := Etype (E); + + begin + if Ekind (Typ) in E_Anonymous_Access_Type + | E_Anonymous_Access_Subprogram_Type + and then not Has_Convention_Pragma (Typ) + then + Set_Basic_Convention (Typ, Val); + Set_Has_Convention_Pragma (Typ); + + -- And for the access subprogram type, deal similarly with the + -- designated E_Subprogram_Type, which is always internal. + + if Ekind (Typ) = E_Anonymous_Access_Subprogram_Type then + declare + Dtype : constant Entity_Id := Designated_Type (Typ); + begin + if Ekind (Dtype) = E_Subprogram_Type + and then not Has_Convention_Pragma (Dtype) + then + Set_Basic_Convention (Dtype, Val); + Set_Has_Convention_Pragma (Dtype); + end if; + end; + end if; + end if; + end; + end if; + end Set_Convention; + + ----------------------- + -- Set_DIC_Procedure -- + ----------------------- + + procedure Set_DIC_Procedure (Id : E; V : E) is + Base_Typ : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id)); + + Base_Typ := Base_Type (Id); + Subps := Subprograms_For_Type (Base_Typ); + + if No (Subps) then + Subps := New_Elmt_List; + Set_Subprograms_For_Type (Base_Typ, Subps); + end if; + + Prepend_Elmt (V, Subps); + end Set_DIC_Procedure; + + procedure Set_Partial_DIC_Procedure (Id : E; V : E) is + begin + Set_DIC_Procedure (Id, V); + end Set_Partial_DIC_Procedure; + + ----------------------------- + -- Set_Invariant_Procedure -- + ----------------------------- + + procedure Set_Invariant_Procedure (Id : E; V : E) is + Base_Typ : Entity_Id; + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id)); + + Base_Typ := Base_Type (Id); + Subps := Subprograms_For_Type (Base_Typ); + + if No (Subps) then + Subps := New_Elmt_List; + Set_Subprograms_For_Type (Base_Typ, Subps); + end if; + + Subp_Elmt := First_Elmt (Subps); + Prepend_Elmt (V, Subps); + + -- Check for a duplicate invariant procedure + + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Is_Invariant_Procedure (Subp_Id) then + raise Program_Error; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end Set_Invariant_Procedure; + + ------------------------------------- + -- Set_Partial_Invariant_Procedure -- + ------------------------------------- + + procedure Set_Partial_Invariant_Procedure (Id : E; V : E) is + Base_Typ : Entity_Id; + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id)); + + Base_Typ := Base_Type (Id); + Subps := Subprograms_For_Type (Base_Typ); + + if No (Subps) then + Subps := New_Elmt_List; + Set_Subprograms_For_Type (Base_Typ, Subps); + end if; + + Subp_Elmt := First_Elmt (Subps); + Prepend_Elmt (V, Subps); + + -- Check for a duplicate partial invariant procedure + + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Is_Partial_Invariant_Procedure (Subp_Id) then + raise Program_Error; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end Set_Partial_Invariant_Procedure; + + ---------------------------- + -- Set_Predicate_Function -- + ---------------------------- + + procedure Set_Predicate_Function (Id : E; V : E) is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id) and then Has_Predicates (Id)); + + Subps := Subprograms_For_Type (Id); + + if No (Subps) then + Subps := New_Elmt_List; + Set_Subprograms_For_Type (Id, Subps); + end if; + + Subp_Elmt := First_Elmt (Subps); + Prepend_Elmt (V, Subps); + + -- Check for a duplicate predication function + + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Ekind (Subp_Id) = E_Function + and then Is_Predicate_Function (Subp_Id) + then + raise Program_Error; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end Set_Predicate_Function; + + ------------------------------ + -- Set_Predicate_Function_M -- + ------------------------------ + + procedure Set_Predicate_Function_M (Id : E; V : E) is + Subp_Elmt : Elmt_Id; + Subp_Id : Entity_Id; + Subps : Elist_Id; + + begin + pragma Assert (Is_Type (Id) and then Has_Predicates (Id)); + + Subps := Subprograms_For_Type (Id); + + if No (Subps) then + Subps := New_Elmt_List; + Set_Subprograms_For_Type (Id, Subps); + end if; + + Subp_Elmt := First_Elmt (Subps); + Prepend_Elmt (V, Subps); + + -- Check for a duplicate predication function + + while Present (Subp_Elmt) loop + Subp_Id := Node (Subp_Elmt); + + if Ekind (Subp_Id) = E_Function + and then Is_Predicate_Function_M (Subp_Id) + then + raise Program_Error; + end if; + + Next_Elmt (Subp_Elmt); + end loop; + end Set_Predicate_Function_M; + + ----------------- + -- Size_Clause -- + ----------------- + + function Size_Clause (Id : E) return N is + begin + return Get_Attribute_Definition_Clause (Id, Attribute_Size); + end Size_Clause; + + ------------------------ + -- Stream_Size_Clause -- + ------------------------ + + function Stream_Size_Clause (Id : E) return N is + begin + return Get_Attribute_Definition_Clause (Id, Attribute_Stream_Size); + end Stream_Size_Clause; + + ------------------ + -- Subtype_Kind -- + ------------------ + + function Subtype_Kind (K : Entity_Kind) return Entity_Kind is + Kind : Entity_Kind; + + begin + case K is + when Access_Kind => + Kind := E_Access_Subtype; + + when E_Array_Subtype + | E_Array_Type + => + Kind := E_Array_Subtype; + + when E_Class_Wide_Subtype + | E_Class_Wide_Type + => + Kind := E_Class_Wide_Subtype; + + when E_Decimal_Fixed_Point_Subtype + | E_Decimal_Fixed_Point_Type + => + Kind := E_Decimal_Fixed_Point_Subtype; + + when E_Ordinary_Fixed_Point_Subtype + | E_Ordinary_Fixed_Point_Type + => + Kind := E_Ordinary_Fixed_Point_Subtype; + + when E_Private_Subtype + | E_Private_Type + => + Kind := E_Private_Subtype; + + when E_Limited_Private_Subtype + | E_Limited_Private_Type + => + Kind := E_Limited_Private_Subtype; + + when E_Record_Subtype_With_Private + | E_Record_Type_With_Private + => + Kind := E_Record_Subtype_With_Private; + + when E_Record_Subtype + | E_Record_Type + => + Kind := E_Record_Subtype; + + when Enumeration_Kind => + Kind := E_Enumeration_Subtype; + + when E_Incomplete_Type => + Kind := E_Incomplete_Subtype; + + when Float_Kind => + Kind := E_Floating_Point_Subtype; + + when Signed_Integer_Kind => + Kind := E_Signed_Integer_Subtype; + + when Modular_Integer_Kind => + Kind := E_Modular_Integer_Subtype; + + when Protected_Kind => + Kind := E_Protected_Subtype; + + when Task_Kind => + Kind := E_Task_Subtype; + + when others => + raise Program_Error; + end case; + + return Kind; + end Subtype_Kind; + + --------------------- + -- Type_High_Bound -- + --------------------- + + function Type_High_Bound (Id : E) return Node_Id is + Rng : constant Node_Id := Scalar_Range (Id); + begin + if Nkind (Rng) = N_Subtype_Indication then + return High_Bound (Range_Expression (Constraint (Rng))); + else + return High_Bound (Rng); + end if; + end Type_High_Bound; + + -------------------- + -- Type_Low_Bound -- + -------------------- + + function Type_Low_Bound (Id : E) return Node_Id is + Rng : constant Node_Id := Scalar_Range (Id); + begin + if Nkind (Rng) = N_Subtype_Indication then + return Low_Bound (Range_Expression (Constraint (Rng))); + else + return Low_Bound (Rng); + end if; + end Type_Low_Bound; + + --------------------- + -- Underlying_Type -- + --------------------- + + function Underlying_Type (Id : E) return E is + begin + -- For record_with_private the underlying type is always the direct full + -- view. Never try to take the full view of the parent it does not make + -- sense. + + if Ekind (Id) = E_Record_Type_With_Private then + return Full_View (Id); + + -- If we have a class-wide type that comes from the limited view then we + -- return the Underlying_Type of its nonlimited view. + + elsif Ekind (Id) = E_Class_Wide_Type + and then From_Limited_With (Id) + and then Present (Non_Limited_View (Id)) + then + return Underlying_Type (Non_Limited_View (Id)); + + elsif Ekind (Id) in Incomplete_Or_Private_Kind then + + -- If we have an incomplete or private type with a full view, then we + -- return the Underlying_Type of this full view. + + if Present (Full_View (Id)) then + if Id = Full_View (Id) then + + -- Previous error in declaration + + return Empty; + + else + return Underlying_Type (Full_View (Id)); + end if; + + -- If we have a private type with an underlying full view, then we + -- return the Underlying_Type of this underlying full view. + + elsif Ekind (Id) in Private_Kind + and then Present (Underlying_Full_View (Id)) + then + return Underlying_Type (Underlying_Full_View (Id)); + + -- If we have an incomplete entity that comes from the limited view + -- then we return the Underlying_Type of its nonlimited view. + + elsif From_Limited_With (Id) + and then Present (Non_Limited_View (Id)) + then + return Underlying_Type (Non_Limited_View (Id)); + + -- Otherwise check for the case where we have a derived type or + -- subtype, and if so get the Underlying_Type of the parent type. + + elsif Etype (Id) /= Id then + return Underlying_Type (Etype (Id)); + + -- Otherwise we have an incomplete or private type that has no full + -- view, which means that we have not encountered the completion, so + -- return Empty to indicate the underlying type is not yet known. + + else + return Empty; + end if; + + -- For non-incomplete, non-private types, return the type itself. Also + -- for entities that are not types at all return the entity itself. + + else + return Id; + end if; + end Underlying_Type; + + ------------------------ + -- Unlink_Next_Entity -- + ------------------------ + + procedure Unlink_Next_Entity (Id : Entity_Id) is + Next : constant Entity_Id := Next_Entity (Id); + + begin + if Present (Next) then + Set_Prev_Entity (Next, Empty); -- Empty <-- Next + end if; + + Set_Next_Entity (Id, Empty); -- Id --> Empty + end Unlink_Next_Entity; + + ---------------------------------- + -- Is_Volatile, Set_Is_Volatile -- + ---------------------------------- + + function Is_Volatile (Id : E) return B is + begin + -- ????The old version has a comment that says: + -- The flag is not set reliably on private subtypes, + -- and is always retrieved from the base type (but this is not a + -- base-type-only attribute because it applies to other entities). + -- Perhaps it should be set reliably, and perhaps it should be + -- Base_Type_Only, but that doesn't work because it is currently + -- set on subtypes, so we have to explicitly fetch the Base_Type below. + -- + -- It might be cleaner if the call sites called Is_Volatile_Type + -- or Is_Volatile_Object directly; surely they know which it is. + + pragma Assert (Nkind (Id) in N_Entity); + + if Is_Type (Id) then + return Is_Volatile_Type (Base_Type (Id)); + else + return Is_Volatile_Object (Id); + end if; + end Is_Volatile; + + procedure Set_Is_Volatile (Id : E; V : B := True) is + begin + pragma Assert (Nkind (Id) in N_Entity); + + if Is_Type (Id) then + Set_Is_Volatile_Type (Id, V); + else + Set_Is_Volatile_Object (Id, V); + end if; + end Set_Is_Volatile; + + ----------------------- + -- Write_Entity_Info -- + ----------------------- + + procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is + + procedure Write_Attribute (Which : String; Nam : E); + -- Write attribute value with given string name + + procedure Write_Kind (Id : Entity_Id); + -- Write Ekind field of entity + + --------------------- + -- Write_Attribute -- + --------------------- + + procedure Write_Attribute (Which : String; Nam : E) is + begin + Write_Str (Prefix); + Write_Str (Which); + Write_Int (Int (Nam)); + Write_Str (" "); + Write_Name (Chars (Nam)); + Write_Str (" "); + end Write_Attribute; + + ---------------- + -- Write_Kind -- + ---------------- + + procedure Write_Kind (Id : Entity_Id) is + K : constant String := Entity_Kind'Image (Ekind (Id)); + + begin + Write_Str (Prefix); + Write_Str (" Kind "); + + if Is_Type (Id) and then Is_Tagged_Type (Id) then + Write_Str ("TAGGED "); + end if; + + Write_Str (K (3 .. K'Length)); + Write_Str (" "); + + if Is_Type (Id) and then Depends_On_Private (Id) then + Write_Str ("Depends_On_Private "); + end if; + end Write_Kind; + + -- Start of processing for Write_Entity_Info + + begin + Write_Eol; + Write_Attribute ("Name ", Id); + Write_Int (Int (Id)); + Write_Eol; + Write_Kind (Id); + Write_Eol; + Write_Attribute (" Type ", Etype (Id)); + Write_Eol; + if Id /= Standard_Standard then + Write_Attribute (" Scope ", Scope (Id)); + end if; + Write_Eol; + + case Ekind (Id) is + when Discrete_Kind => + Write_Str ("Bounds: Id = "); + + if Present (Scalar_Range (Id)) then + Write_Int (Int (Type_Low_Bound (Id))); + Write_Str (" .. Id = "); + Write_Int (Int (Type_High_Bound (Id))); + else + Write_Str ("Empty"); + end if; + + Write_Eol; + + when Array_Kind => + declare + Index : Entity_Id; + + begin + Write_Attribute + (" Component Type ", Component_Type (Id)); + Write_Eol; + Write_Str (Prefix); + Write_Str (" Indexes "); + + Index := First_Index (Id); + while Present (Index) loop + Write_Attribute (" ", Etype (Index)); + Index := Next_Index (Index); + end loop; + + Write_Eol; + end; + + when Access_Kind => + Write_Attribute + (" Directly Designated Type ", + Directly_Designated_Type (Id)); + Write_Eol; + + when Overloadable_Kind => + if Present (Homonym (Id)) then + Write_Str (" Homonym "); + Write_Name (Chars (Homonym (Id))); + Write_Str (" "); + Write_Int (Int (Homonym (Id))); + Write_Eol; + end if; + + Write_Eol; + + when E_Component => + if Ekind (Scope (Id)) in Record_Kind then + Write_Attribute ( + " Original_Record_Component ", + Original_Record_Component (Id)); + Write_Int (Int (Original_Record_Component (Id))); + Write_Eol; + end if; + + when others => + null; + end case; + end Write_Entity_Info; + + ------------------------- + -- Iterator Procedures -- + ------------------------- + + procedure Proc_Next_Component (N : in out Node_Id) is + begin + N := Next_Component (N); + end Proc_Next_Component; + + procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is + begin + N := Next_Entity (N); + while Present (N) loop + exit when Ekind (N) in E_Component | E_Discriminant; + N := Next_Entity (N); + end loop; + end Proc_Next_Component_Or_Discriminant; + + procedure Proc_Next_Discriminant (N : in out Node_Id) is + begin + N := Next_Discriminant (N); + end Proc_Next_Discriminant; + + procedure Proc_Next_Formal (N : in out Node_Id) is + begin + N := Next_Formal (N); + end Proc_Next_Formal; + + procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is + begin + N := Next_Formal_With_Extras (N); + end Proc_Next_Formal_With_Extras; + + procedure Proc_Next_Index (N : in out Node_Id) is + begin + N := Next_Index (N); + end Proc_Next_Index; + + procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is + begin + N := Next_Inlined_Subprogram (N); + end Proc_Next_Inlined_Subprogram; + + procedure Proc_Next_Literal (N : in out Node_Id) is + begin + N := Next_Literal (N); + end Proc_Next_Literal; + + procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is + begin + N := Next_Stored_Discriminant (N); + end Proc_Next_Stored_Discriminant; + +end Einfo.Utils; diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads new file mode 100644 index 00000000000..321caefca5e --- /dev/null +++ b/gcc/ada/einfo-utils.ads @@ -0,0 +1,682 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- E I N F O . U T I L S -- +-- -- +-- 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. 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 Einfo.Entities; use Einfo.Entities; + +package Einfo.Utils is + + ----------------------------------- + -- Renamings of Renamed_Or_Alias -- + ----------------------------------- + + -- See the comment in einfo.ads, "Renaming and Aliasing", which is somewhat + -- incorrect. In fact, the compiler uses Alias, Renamed_Entity, and + -- Renamed_Object more-or-less interchangeably, so we rename them here. + -- ????Should add preconditions. + + function Alias + (N : Entity_Id) return Node_Id renames Renamed_Or_Alias; + procedure Set_Alias + (N : Entity_Id; Val : Node_Id) renames Set_Renamed_Or_Alias; + function Renamed_Entity + (N : Entity_Id) return Node_Id renames Renamed_Or_Alias; + procedure Set_Renamed_Entity + (N : Entity_Id; Val : Node_Id) renames Set_Renamed_Or_Alias; + function Renamed_Object + (N : Entity_Id) return Node_Id renames Renamed_Or_Alias; + procedure Set_Renamed_Object + (N : Entity_Id; Val : Node_Id) renames Set_Renamed_Or_Alias; + + -------------------------- + -- Subtype Declarations -- + -------------------------- + + -- ???? + -- The above entities are arranged so that they can be conveniently grouped + -- into subtype ranges. Note that for each of the xxx_Kind ranges defined + -- below, there is a corresponding Is_xxx (or for types, Is_xxx_Type) + -- predicate which is to be used in preference to direct range tests using + -- the subtype name. However, the subtype names are available for direct + -- use, e.g. as choices in case statements. + + ------------------- + -- Type Synonyms -- + ------------------- + + -- The following type synonyms are used to tidy up the function and + -- procedure declarations that follow, and also to make it possible to meet + -- the requirement for the XEINFO utility that all function specs must fit + -- on a single source line.???? + + subtype B is Boolean; + subtype C is Component_Alignment_Kind; + subtype E is Entity_Id; + subtype F is Float_Rep_Kind; + subtype M is Mechanism_Type; + subtype N is Node_Id; + subtype U is Uint; + subtype R is Ureal; + subtype L is Elist_Id; + subtype S is List_Id; + + ------------------------------- + -- Classification Attributes -- + ------------------------------- + + -- These functions provide a convenient functional notation for testing + -- whether an Ekind value belongs to a specified kind, for example the + -- function Is_Elementary_Type tests if its argument is in Elementary_Kind. + -- In some cases, the test is of an entity attribute (e.g. in the case of + -- Is_Generic_Type where the Ekind does not provide the needed + -- information). + -- ????Could automatically generate some of these? + + function Is_Access_Object_Type (Id : E) return B; + function Is_Access_Type (Id : E) return B; + function Is_Access_Protected_Subprogram_Type (Id : E) return B; + function Is_Access_Subprogram_Type (Id : E) return B; + function Is_Aggregate_Type (Id : E) return B; + function Is_Anonymous_Access_Type (Id : E) return B; + function Is_Array_Type (Id : E) return B; + function Is_Assignable (Id : E) return B; + function Is_Class_Wide_Type (Id : E) return B; + function Is_Composite_Type (Id : E) return B; + function Is_Concurrent_Body (Id : E) return B; + function Is_Concurrent_Type (Id : E) return B; + function Is_Decimal_Fixed_Point_Type (Id : E) return B; + function Is_Digits_Type (Id : E) return B; + function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B; + function Is_Discrete_Type (Id : E) return B; + function Is_Elementary_Type (Id : E) return B; + function Is_Entry (Id : E) return B; + function Is_Enumeration_Type (Id : E) return B; + function Is_Fixed_Point_Type (Id : E) return B; + function Is_Floating_Point_Type (Id : E) return B; + function Is_Formal (Id : E) return B; + function Is_Formal_Object (Id : E) return B; + function Is_Generic_Subprogram (Id : E) return B; + function Is_Generic_Unit (Id : E) return B; + function Is_Ghost_Entity (Id : E) return B; + function Is_Incomplete_Or_Private_Type (Id : E) return B; + function Is_Incomplete_Type (Id : E) return B; + function Is_Integer_Type (Id : E) return B; + function Is_Modular_Integer_Type (Id : E) return B; + function Is_Named_Access_Type (Id : E) return B; + function Is_Named_Number (Id : E) return B; + function Is_Numeric_Type (Id : E) return B; + function Is_Object (Id : E) return B; + function Is_Ordinary_Fixed_Point_Type (Id : E) return B; + function Is_Overloadable (Id : E) return B; + function Is_Private_Type (Id : E) return B; + function Is_Protected_Type (Id : E) return B; + function Is_Real_Type (Id : E) return B; + function Is_Record_Type (Id : E) return B; + function Is_Scalar_Type (Id : E) return B; + function Is_Signed_Integer_Type (Id : E) return B; + function Is_Subprogram (Id : E) return B; + function Is_Subprogram_Or_Entry (Id : E) return B; + function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B; + function Is_Task_Type (Id : E) return B; + function Is_Type (Id : E) return B; + + ------------------------------------- + -- Synthesized Attribute Functions -- + ------------------------------------- + + -- The functions in this section synthesize attributes from the tree, + -- so they do not correspond to defined fields in the entity itself. + + function Address_Clause (Id : E) return N; + function Aft_Value (Id : E) return U; + function Alignment_Clause (Id : E) return N; + function Base_Type (Id : E) return E; + function Declaration_Node (Id : E) return N; + function Designated_Type (Id : E) return E; + function Entry_Index_Type (Id : E) return E; + function First_Component (Id : E) return E; + function First_Component_Or_Discriminant (Id : E) return E; + function First_Formal (Id : E) return E; + function First_Formal_With_Extras (Id : E) return E; + function Has_Attach_Handler (Id : E) return B; + function Has_DIC (Id : E) return B; + function Has_Entries (Id : E) return B; + function Has_Foreign_Convention (Id : E) return B; + function Has_Interrupt_Handler (Id : E) return B; + function Has_Invariants (Id : E) return B; + function Has_Limited_View (Id : E) return B; + function Has_Non_Limited_View (Id : E) return B; + function Has_Non_Null_Abstract_State (Id : E) return B; + function Has_Non_Null_Visible_Refinement (Id : E) return B; + function Has_Null_Abstract_State (Id : E) return B; + function Has_Null_Visible_Refinement (Id : E) return B; + function Implementation_Base_Type (Id : E) return E; + function Is_Base_Type (Id : E) return B; + function Is_Boolean_Type (Id : E) return B; + function Is_Constant_Object (Id : E) return B; + function Is_Controlled (Id : E) return B; + function Is_Discriminal (Id : E) return B; + function Is_Dynamic_Scope (Id : E) return B; + function Is_Elaboration_Target (Id : E) return B; + function Is_External_State (Id : E) return B; + function Is_Finalizer (Id : E) return B; + function Is_Full_Access (Id : E) return B; + function Is_Null_State (Id : E) return B; + function Is_Package_Or_Generic_Package (Id : E) return B; + function Is_Packed_Array (Id : E) return B; + function Is_Prival (Id : E) return B; + function Is_Protected_Component (Id : E) return B; + function Is_Protected_Interface (Id : E) return B; + function Is_Protected_Record_Type (Id : E) return B; + function Is_Relaxed_Initialization_State (Id : E) return B; + function Is_Standard_Character_Type (Id : E) return B; + function Is_Standard_String_Type (Id : E) return B; + function Is_String_Type (Id : E) return B; + function Is_Synchronized_Interface (Id : E) return B; + function Is_Synchronized_State (Id : E) return B; + function Is_Task_Interface (Id : E) return B; + function Is_Task_Record_Type (Id : E) return B; + function Is_Wrapper_Package (Id : E) return B; + function Last_Formal (Id : E) return E; + function Machine_Emax_Value (Id : E) return U; + function Machine_Emin_Value (Id : E) return U; + function Machine_Mantissa_Value (Id : E) return U; + function Machine_Radix_Value (Id : E) return U; + function Model_Emin_Value (Id : E) return U; + function Model_Epsilon_Value (Id : E) return R; + function Model_Mantissa_Value (Id : E) return U; + function Model_Small_Value (Id : E) return R; + function Next_Component (Id : E) return E; + function Next_Component_Or_Discriminant (Id : E) return E; + function Next_Discriminant (Id : E) return E; + function Next_Formal (Id : E) return E; + function Next_Formal_With_Extras (Id : E) return E; + function Next_Index (Id : N) return N; + function Next_Literal (Id : E) return E; + function Next_Stored_Discriminant (Id : E) return E; + function Number_Dimensions (Id : E) return Pos; + function Number_Entries (Id : E) return Nat; + function Number_Formals (Id : E) return Pos; + function Object_Size_Clause (Id : E) return N; + function Parameter_Mode (Id : E) return Formal_Kind; + function Partial_Refinement_Constituents (Id : E) return L; + function Primitive_Operations (Id : E) return L; + function Root_Type (Id : E) return E; + function Safe_Emax_Value (Id : E) return U; + function Safe_First_Value (Id : E) return R; + function Safe_Last_Value (Id : E) return R; + function Scope_Depth (Id : E) return U; + function Scope_Depth_Set (Id : E) return B; + function Size_Clause (Id : E) return N; + function Stream_Size_Clause (Id : E) return N; + function Type_High_Bound (Id : E) return N; + function Type_Low_Bound (Id : E) return N; + function Underlying_Type (Id : E) return E; + + ---------------------------------------------- + -- Type Representation Attribute Predicates -- + ---------------------------------------------- + + -- These predicates test the setting of the indicated attribute. If the + -- value has been set, then Known is True, and Unknown is False. If no + -- value is set, then Known is False and Unknown is True. The Known_Static + -- predicate is true only if the value is set (Known) and is set to a + -- compile time known value. Note that in the case of Alignment and + -- Normalized_First_Bit, dynamic values are not possible, so we do not + -- need a separate Known_Static calls in these cases. The not set (unknown) + -- values are as follows: + + -- Alignment Uint_0 or No_Uint + -- Component_Size Uint_0 or No_Uint + -- Component_Bit_Offset No_Uint + -- Digits_Value Uint_0 or No_Uint + -- Esize Uint_0 or No_Uint + -- Normalized_First_Bit No_Uint + -- Normalized_Position No_Uint + -- Normalized_Position_Max No_Uint + -- RM_Size Uint_0 or No_Uint + + -- It would be cleaner to use No_Uint in all these cases, but historically + -- we chose to use Uint_0 at first, and the change over will take time ??? + -- This is particularly true for the RM_Size field, where a value of zero + -- is legitimate. We deal with this by a considering that the value is + -- always known static for discrete types (and no other types can have + -- an RM_Size value of zero). + + -- In two cases, Known_Static_Esize and Known_Static_RM_Size, there is one + -- more consideration, which is that we always return False for generic + -- types. Within a template, the size can look known, because of the fake + -- size values we put in template types, but they are not really known and + -- anyone testing if they are known within the template should get False as + -- a result to prevent incorrect assumptions. + + function Known_Alignment (E : Entity_Id) return B; + function Known_Component_Bit_Offset (E : Entity_Id) return B; + function Known_Component_Size (E : Entity_Id) return B; + function Known_Esize (E : Entity_Id) return B; + function Known_Normalized_First_Bit (E : Entity_Id) return B; + function Known_Normalized_Position (E : Entity_Id) return B; + function Known_Normalized_Position_Max (E : Entity_Id) return B; + function Known_RM_Size (E : Entity_Id) return B; + + function Known_Static_Component_Bit_Offset (E : Entity_Id) return B; + function Known_Static_Component_Size (E : Entity_Id) return B; + function Known_Static_Esize (E : Entity_Id) return B; + function Known_Static_Normalized_First_Bit (E : Entity_Id) return B; + function Known_Static_Normalized_Position (E : Entity_Id) return B; + function Known_Static_Normalized_Position_Max (E : Entity_Id) return B; + function Known_Static_RM_Size (E : Entity_Id) return B; + + function Unknown_Alignment (E : Entity_Id) return B; + function Unknown_Component_Bit_Offset (E : Entity_Id) return B; + function Unknown_Component_Size (E : Entity_Id) return B; + function Unknown_Esize (E : Entity_Id) return B; + function Unknown_Normalized_First_Bit (E : Entity_Id) return B; + function Unknown_Normalized_Position (E : Entity_Id) return B; + function Unknown_Normalized_Position_Max (E : Entity_Id) return B; + function Unknown_RM_Size (E : Entity_Id) return B; + + --------------------------------------------------- + -- Access to Subprograms in Subprograms_For_Type -- + --------------------------------------------------- + + function Is_Partial_DIC_Procedure (Id : E) return B; + + function DIC_Procedure (Id : E) return E; + function Partial_DIC_Procedure (Id : E) return E; + function Invariant_Procedure (Id : E) return E; + function Partial_Invariant_Procedure (Id : E) return E; + function Predicate_Function (Id : E) return E; + function Predicate_Function_M (Id : E) return E; + + procedure Set_DIC_Procedure (Id : E; V : E); + procedure Set_Partial_DIC_Procedure (Id : E; V : E); + procedure Set_Invariant_Procedure (Id : E; V : E); + procedure Set_Partial_Invariant_Procedure (Id : E; V : E); + procedure Set_Predicate_Function (Id : E; V : E); + procedure Set_Predicate_Function_M (Id : E; V : E); + + ----------------------------------- + -- Field Initialization Routines -- + ----------------------------------- + + -- These routines are overloadings of some of the above Set procedures + -- where the argument is normally a Uint. The overloadings take an Int + -- parameter instead, and appropriately convert it. There are also + -- versions that implicitly initialize to the appropriate "not set" + -- value. The not set (unknown) values are as follows: + + -- Alignment Uint_0 + -- Component_Size Uint_0 + -- Component_Bit_Offset No_Uint + -- Digits_Value Uint_0 + -- Esize Uint_0 + -- Normalized_First_Bit No_Uint + -- Normalized_Position No_Uint + -- Normalized_Position_Max No_Uint + -- RM_Size Uint_0 + + -- It would be cleaner to use No_Uint in all these cases, but historically + -- we chose to use Uint_0 at first, and the change over will take time ??? + -- This is particularly true for the RM_Size field, where a value of zero + -- is legitimate and causes some special tests around the code. + + -- Contrary to the corresponding Set procedures above, these routines + -- do NOT check the entity kind of their argument, instead they set the + -- underlying Uint fields directly (this allows them to be used for + -- entities whose Ekind has not been set yet). + + procedure Init_Alignment (Id : E; V : Int); + procedure Init_Component_Bit_Offset (Id : E; V : Int); + procedure Init_Component_Size (Id : E; V : Int); + procedure Init_Digits_Value (Id : E; V : Int); + procedure Init_Esize (Id : E; V : Int); + procedure Init_Normalized_First_Bit (Id : E; V : Int); + procedure Init_Normalized_Position (Id : E; V : Int); + procedure Init_Normalized_Position_Max (Id : E; V : Int); + procedure Init_RM_Size (Id : E; V : Int); + + procedure Init_Alignment (Id : E); + procedure Init_Component_Bit_Offset (Id : E); + procedure Init_Component_Size (Id : E); + procedure Init_Digits_Value (Id : E); + procedure Init_Esize (Id : E); + procedure Init_Normalized_First_Bit (Id : E); + procedure Init_Normalized_Position (Id : E); + procedure Init_Normalized_Position_Max (Id : E); + procedure Init_RM_Size (Id : E); + + procedure Init_Component_Location (Id : E); + -- Initializes all fields describing the location of a component + -- (Normalized_Position, Component_Bit_Offset, Normalized_First_Bit, + -- Normalized_Position_Max, Esize) to all be Unknown. + + procedure Init_Size (Id : E; V : Int); + -- Initialize both the Esize and RM_Size fields of E to V + + procedure Init_Size_Align (Id : E); + -- This procedure initializes both size fields and the alignment + -- field to all be Unknown. + + procedure Init_Object_Size_Align (Id : E); + -- Same as Init_Size_Align except RM_Size field (which is only for types) + -- is unaffected. + + --------------- + -- Iterators -- + --------------- + + -- The call to Next_xxx (obj) is equivalent to obj := Next_xxx (obj) + -- We define the set of Proc_Next_xxx routines simply for the purposes + -- of inlining them without necessarily inlining the function. + + procedure Proc_Next_Component (N : in out Node_Id); + procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id); + procedure Proc_Next_Discriminant (N : in out Node_Id); + procedure Proc_Next_Formal (N : in out Node_Id); + procedure Proc_Next_Formal_With_Extras (N : in out Node_Id); + procedure Proc_Next_Index (N : in out Node_Id); + procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id); + procedure Proc_Next_Literal (N : in out Node_Id); + procedure Proc_Next_Stored_Discriminant (N : in out Node_Id); + + pragma Inline (Proc_Next_Component); + pragma Inline (Proc_Next_Component_Or_Discriminant); + pragma Inline (Proc_Next_Discriminant); + pragma Inline (Proc_Next_Formal); + pragma Inline (Proc_Next_Formal_With_Extras); + pragma Inline (Proc_Next_Index); + pragma Inline (Proc_Next_Inlined_Subprogram); + pragma Inline (Proc_Next_Literal); + pragma Inline (Proc_Next_Stored_Discriminant); + + procedure Next_Component (N : in out Node_Id) + renames Proc_Next_Component; + + procedure Next_Component_Or_Discriminant (N : in out Node_Id) + renames Proc_Next_Component_Or_Discriminant; + + procedure Next_Discriminant (N : in out Node_Id) + renames Proc_Next_Discriminant; + + procedure Next_Formal (N : in out Node_Id) + renames Proc_Next_Formal; + + procedure Next_Formal_With_Extras (N : in out Node_Id) + renames Proc_Next_Formal_With_Extras; + + procedure Next_Index (N : in out Node_Id) + renames Proc_Next_Index; + + procedure Next_Inlined_Subprogram (N : in out Node_Id) + renames Proc_Next_Inlined_Subprogram; + + procedure Next_Literal (N : in out Node_Id) + renames Proc_Next_Literal; + + procedure Next_Stored_Discriminant (N : in out Node_Id) + renames Proc_Next_Stored_Discriminant; + + --------------------------- + -- Testing Warning Flags -- + --------------------------- + + -- These routines are to be used rather than testing flags Warnings_Off, + -- Has_Pragma_Unmodified, Has_Pragma_Unreferenced. They deal with setting + -- the flags Warnings_Off_Used[_Unmodified|Unreferenced] for later access. + + function Has_Warnings_Off (E : Entity_Id) return Boolean; + -- If Warnings_Off is set on E, then returns True and also sets the flag + -- Warnings_Off_Used on E. If Warnings_Off is not set on E, returns False + -- and has no side effect. + + function Has_Unmodified (E : Entity_Id) return Boolean; + -- If flag Has_Pragma_Unmodified is set on E, returns True with no side + -- effects. Otherwise if Warnings_Off is set on E, returns True and also + -- sets the flag Warnings_Off_Used_Unmodified on E. If neither of the flags + -- Warnings_Off nor Has_Pragma_Unmodified is set, returns False with no + -- side effects. + + function Has_Unreferenced (E : Entity_Id) return Boolean; + -- If flag Has_Pragma_Unreferenced is set on E, returns True with no side + -- effects. Otherwise if Warnings_Off is set on E, returns True and also + -- sets the flag Warnings_Off_Used_Unreferenced on E. If neither of the + -- flags Warnings_Off nor Has_Pragma_Unreferenced is set, returns False + -- with no side effects. + + ---------------------------------------------- + -- Subprograms for Accessing Rep Item Chain -- + ---------------------------------------------- + + -- The First_Rep_Item field of every entity points to a linked list (linked + -- through Next_Rep_Item) of representation pragmas, attribute definition + -- clauses, representation clauses, and aspect specifications that apply to + -- the item. Note that in the case of types, it is assumed that any such + -- rep items for a base type also apply to all subtypes. This is achieved + -- by having the chain for subtypes link onto the chain for the base type, + -- so that new entries for the subtype are added at the start of the chain. + -- + -- Note: aspect specification nodes are linked only when evaluation of the + -- expression is deferred to the freeze point. For further details see + -- Sem_Ch13.Analyze_Aspect_Specifications. + + function Get_Attribute_Definition_Clause + (E : Entity_Id; + Id : Attribute_Id) return Node_Id; + -- Searches the Rep_Item chain for a given entity E, for an instance of an + -- attribute definition clause with the given attribute Id. If found, the + -- value returned is the N_Attribute_Definition_Clause node, otherwise + -- Empty is returned. + + -- WARNING: There is a matching C declaration of this subprogram in fe.h + + function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id; + -- Searches the Rep_Item chain of entity E, for an instance of a pragma + -- with the given pragma Id. If found, the value returned is the N_Pragma + -- node, otherwise Empty is returned. The following contract pragmas that + -- appear in N_Contract nodes are also handled by this routine: + -- Abstract_State + -- Async_Readers + -- Async_Writers + -- Attach_Handler + -- Constant_After_Elaboration + -- Contract_Cases + -- Depends + -- Effective_Reads + -- Effective_Writes + -- Global + -- Initial_Condition + -- Initializes + -- Interrupt_Handler + -- No_Caching + -- Part_Of + -- Precondition + -- Postcondition + -- Refined_Depends + -- Refined_Global + -- Refined_Post + -- Refined_State + -- Subprogram_Variant + -- Test_Case + -- Volatile_Function + + function Get_Class_Wide_Pragma + (E : Entity_Id; + Id : Pragma_Id) return Node_Id; + -- Examine Rep_Item chain to locate a classwide pre- or postcondition of a + -- primitive operation. Returns Empty if not present. + + function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id; + -- Searches the Rep_Item chain for a given entity E, for a record + -- representation clause, and if found, returns it. Returns Empty + -- if no such clause is found. + + function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean; + -- Return True if N is present in the Rep_Item chain for a given entity E + + procedure Record_Rep_Item (E : Entity_Id; N : Node_Id); + -- N is the node for a representation pragma, representation clause, an + -- attribute definition clause, or an aspect specification that applies to + -- entity E. This procedure links the node N onto the Rep_Item chain for + -- entity E. Note that it is an error to call this procedure with E being + -- overloadable, and N being a pragma that applies to multiple overloadable + -- entities (Convention, Interface, Inline, Inline_Always, Import, Export, + -- External). This is not allowed even in the case where the entity is not + -- overloaded, since we can't rely on it being present in the overloaded + -- case, it is not useful to have it present in the non-overloaded case. + + ------------------------------- + -- Miscellaneous Subprograms -- + ------------------------------- + + procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id); + -- Add an entity to the list of entities declared in the scope Scop + + function Get_Full_View (T : Entity_Id) return Entity_Id; + -- If T is an incomplete type and the full declaration has been seen, or + -- is the name of a class_wide type whose root is incomplete, return the + -- corresponding full declaration, else return T itself. + + function Is_Entity_Name (N : Node_Id) return Boolean; + -- Test if the node N is the name of an entity (i.e. is an identifier, + -- expanded name, or an attribute reference that returns an entity). + + -- WARNING: There is a matching C declaration of this subprogram in fe.h + + procedure Link_Entities (First : Entity_Id; Second : Entity_Id); + -- Link entities First and Second in one entity chain. + -- + -- NOTE: No updates are done to the First_Entity and Last_Entity fields + -- of the scope. + + procedure Remove_Entity (Id : Entity_Id); + -- Remove entity Id from the entity chain of its scope + + function Subtype_Kind (K : Entity_Kind) return Entity_Kind; + -- Given an entity_kind K this function returns the entity_kind + -- corresponding to subtype kind of the type represented by K. For + -- example if K is E_Signed_Integer_Type then E_Signed_Integer_Subtype + -- is returned. If K is already a subtype kind it itself is returned. An + -- internal error is generated if no such correspondence exists for K. + + procedure Unlink_Next_Entity (Id : Entity_Id); + -- Unchain entity Id's forward link within the entity chain of its scope + + function Is_Volatile (Id : E) return B; + procedure Set_Is_Volatile (Id : E; V : B := True); + -- Call [Set_]Is_Volatile_Type/Is_Volatile_Object as appropriate for the + -- Ekind of Id. + + function Convention + (N : Entity_Id) return Convention_Id renames Basic_Convention; + procedure Set_Convention (E : Entity_Id; Val : Convention_Id); + -- Same as Set_Basic_Convention, but with an extra check for access types. + -- In particular, if E is an access-to-subprogram type, and Val is a + -- foreign convention, then we set Can_Use_Internal_Rep to False on E. + -- Also, if the Etype of E is set and is an anonymous access type with + -- no convention set, this anonymous type inherits the convention of E. + + ---------------------------------- + -- Debugging Output Subprograms -- + ---------------------------------- + + procedure Write_Entity_Info (Id : Entity_Id; Prefix : String); + -- A debugging procedure to write out information about an entity + + -- ????Make sure the Inlines from Einfo were fully copied here. + -- ???? + -- The following Inline pragmas are *not* read by XEINFO when building the + -- C version of this interface automatically (so the C version will end up + -- making out of line calls). The pragma scan in XEINFO will be terminated + -- on encountering the END XEINFO INLINES line. We inline things here which + -- are small, but not of the canonical attribute access/set format that can + -- be handled by XEINFO. + + pragma Inline (Address_Clause); + pragma Inline (Alignment_Clause); + pragma Inline (Base_Type); + + pragma Inline (Has_Foreign_Convention); + pragma Inline (Has_Non_Limited_View); + pragma Inline (Is_Base_Type); + pragma Inline (Is_Boolean_Type); + pragma Inline (Is_Constant_Object); + pragma Inline (Is_Controlled); + pragma Inline (Is_Discriminal); + pragma Inline (Is_Entity_Name); + pragma Inline (Is_Finalizer); + pragma Inline (Is_Full_Access); + pragma Inline (Is_Null_State); + pragma Inline (Is_Package_Or_Generic_Package); + pragma Inline (Is_Packed_Array); + pragma Inline (Is_Prival); + pragma Inline (Is_Protected_Component); + pragma Inline (Is_Protected_Record_Type); + pragma Inline (Is_String_Type); + pragma Inline (Is_Task_Record_Type); + pragma Inline (Is_Wrapper_Package); + pragma Inline (Scope_Depth); + pragma Inline (Scope_Depth_Set); + pragma Inline (Size_Clause); + pragma Inline (Stream_Size_Clause); + pragma Inline (Type_High_Bound); + pragma Inline (Type_Low_Bound); + + pragma Inline (Known_Alignment); + pragma Inline (Known_Component_Bit_Offset); + pragma Inline (Known_Component_Size); + pragma Inline (Known_Esize); + pragma Inline (Known_Normalized_First_Bit); + pragma Inline (Known_Normalized_Position); + pragma Inline (Known_Normalized_Position_Max); + pragma Inline (Known_RM_Size); + + pragma Inline (Known_Static_Component_Bit_Offset); + pragma Inline (Known_Static_Component_Size); + pragma Inline (Known_Static_Esize); + pragma Inline (Known_Static_Normalized_First_Bit); + pragma Inline (Known_Static_Normalized_Position); + pragma Inline (Known_Static_Normalized_Position_Max); + pragma Inline (Known_Static_RM_Size); + + pragma Inline (Unknown_Alignment); + pragma Inline (Unknown_Component_Bit_Offset); + pragma Inline (Unknown_Component_Size); + pragma Inline (Unknown_Esize); + pragma Inline (Unknown_Normalized_First_Bit); + pragma Inline (Unknown_Normalized_Position); + pragma Inline (Unknown_Normalized_Position_Max); + pragma Inline (Unknown_RM_Size); + + pragma Inline (Init_Alignment); + pragma Inline (Init_Component_Bit_Offset); + pragma Inline (Init_Component_Size); + pragma Inline (Init_Digits_Value); + pragma Inline (Init_Esize); + pragma Inline (Init_Normalized_First_Bit); + pragma Inline (Init_Normalized_Position); + pragma Inline (Init_Normalized_Position_Max); + pragma Inline (Init_RM_Size); + +end Einfo.Utils; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 2da6f4465f9..3202f99b3c2 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -23,11573 +23,4 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Elists; use Elists; -with Namet; use Namet; -with Nlists; use Nlists; -with Output; use Output; -with Sinfo; use Sinfo; -with Stand; use Stand; - -package body Einfo is - - use Atree.Unchecked_Access; - -- This is one of the packages that is allowed direct untyped access to - -- the fields in a node, since it provides the next level abstraction - -- which incorporates appropriate checks. - - ---------------------------------------------- - -- Usage of Fields in Defining Entity Nodes -- - ---------------------------------------------- - - -- Four of these fields are defined in Sinfo, since they in are the base - -- part of the node. The access routines for these four fields and the - -- corresponding set procedures are defined in Sinfo. These fields are - -- present in all entities. Note that Homonym is also in the base part of - -- the node, but has access routines that are more properly part of Einfo, - -- which is why they are defined here. - - -- Chars Name1 - -- Next_Entity Node2 - -- Scope Node3 - -- Etype Node5 - - -- Remaining fields are present only in extended nodes (i.e. entities). - - -- The following fields are present in all entities - - -- Homonym Node4 - -- First_Rep_Item Node6 - -- Freeze_Node Node7 - -- Prev_Entity Node36 - -- Associated_Entity Node37 - - -- The usage of other fields (and the entity kinds to which it applies) - -- depends on the particular field (see Einfo spec for details). - - -- Associated_Node_For_Itype Node8 - -- Dependent_Instances Elist8 - -- Hiding_Loop_Variable Node8 - -- Mechanism Uint8 (but returns Mechanism_Type) - -- Normalized_First_Bit Uint8 - -- Refinement_Constituents Elist8 - -- Return_Applies_To Node8 - -- First_Exit_Statement Node8 - - -- Class_Wide_Type Node9 - -- Current_Value Node9 - -- Renaming_Map Uint9 - - -- Direct_Primitive_Operations Elist10 - -- Discriminal_Link Node10 - -- Float_Rep Uint10 (but returns Float_Rep_Kind) - -- Handler_Records List10 - -- Normalized_Position_Max Uint10 - -- Part_Of_Constituents Elist10 - - -- Block_Node Node11 - -- Component_Bit_Offset Uint11 - -- Full_View Node11 - -- Entry_Component Node11 - -- Enumeration_Pos Uint11 - -- Generic_Homonym Node11 - -- Part_Of_References Elist11 - -- Protected_Body_Subprogram Node11 - - -- Barrier_Function Node12 - -- Enumeration_Rep Uint12 - -- Esize Uint12 - -- Next_Inlined_Subprogram Node12 - - -- Component_Clause Node13 - -- Elaboration_Entity Node13 - -- Extra_Accessibility Node13 - -- RM_Size Uint13 - - -- Alignment Uint14 - -- Normalized_Position Uint14 - -- Postconditions_Proc Node14 - - -- Discriminant_Number Uint15 - -- DT_Position Uint15 - -- DT_Entry_Count Uint15 - -- Entry_Parameters_Type Node15 - -- Extra_Formal Node15 - -- Pending_Access_Types Elist15 - -- Related_Instance Node15 - -- Status_Flag_Or_Transient_Decl Node15 - - -- Access_Disp_Table Elist16 - -- Body_References Elist16 - -- Cloned_Subtype Node16 - -- DTC_Entity Node16 - -- Entry_Formal Node16 - -- First_Private_Entity Node16 - -- Lit_Strings Node16 - -- Scale_Value Uint16 - -- String_Literal_Length Uint16 - -- Unset_Reference Node16 - - -- Actual_Subtype Node17 - -- Digits_Value Uint17 - -- Discriminal Node17 - -- First_Entity Node17 - -- First_Index Node17 - -- First_Literal Node17 - -- Master_Id Node17 - -- Modulus Uint17 - -- Prival Node17 - - -- Alias Node18 - -- Corresponding_Concurrent_Type Node18 - -- Corresponding_Protected_Entry Node18 - -- Corresponding_Record_Type Node18 - -- Delta_Value Ureal18 - -- Enclosing_Scope Node18 - -- Equivalent_Type Node18 - -- Lit_Indexes Node18 - -- Private_Dependents Elist18 - -- Renamed_Entity Node18 - -- Renamed_Object Node18 - -- String_Literal_Low_Bound Node18 - - -- Body_Entity Node19 - -- Corresponding_Discriminant Node19 - -- Default_Aspect_Component_Value Node19 - -- Default_Aspect_Value Node19 - -- Entry_Bodies_Array Node19 - -- Extra_Accessibility_Of_Result Node19 - -- Non_Limited_View Node19 - -- Parent_Subtype Node19 - -- Receiving_Entry Node19 - -- Size_Check_Code Node19 - -- Spec_Entity Node19 - -- Underlying_Full_View Node19 - - -- Component_Type Node20 - -- Default_Value Node20 - -- Directly_Designated_Type Node20 - -- Discriminant_Checking_Func Node20 - -- Discriminant_Default_Value Node20 - -- Last_Entity Node20 - -- Prival_Link Node20 - -- Register_Exception_Call Node20 - -- Scalar_Range Node20 - - -- Accept_Address Elist21 - -- Corresponding_Record_Component Node21 - -- Default_Expr_Function Node21 - -- Discriminant_Constraint Elist21 - -- Lit_Hash Node21 - -- Interface_Name Node21 - -- Original_Array_Type Node21 - -- Small_Value Ureal21 - - -- Associated_Storage_Pool Node22 - -- Component_Size Uint22 - -- Corresponding_Remote_Type Node22 - -- Enumeration_Rep_Expr Node22 - -- Original_Record_Component Node22 - -- Protected_Formal Node22 - -- Scope_Depth_Value Uint22 - -- Shared_Var_Procs_Instance Node22 - - -- CR_Discriminant Node23 - -- Entry_Cancel_Parameter Node23 - -- Enum_Pos_To_Rep Node23 - -- Extra_Constrained Node23 - -- Finalization_Master Node23 - -- Generic_Renamings Elist23 - -- Inner_Instances Elist23 - -- Limited_View Node23 - -- Packed_Array_Impl_Type Node23 - -- Protection_Object Node23 - -- Stored_Constraint Elist23 - - -- Incomplete_Actuals Elist24 - -- Minimum_Accessibility Node24 - -- Related_Expression Node24 - -- Subps_Index Uint24 - - -- Contract_Wrapper Node25 - -- Debug_Renaming_Link Node25 - -- DT_Offset_To_Top_Func Node25 - -- Interface_Alias Node25 - -- Interfaces Elist25 - -- Related_Array_Object Node25 - -- Static_Discrete_Predicate List25 - -- Static_Real_Or_String_Predicate Node25 - -- Task_Body_Procedure Node25 - - -- Dispatch_Table_Wrappers Elist26 - -- Last_Assignment Node26 - -- Overridden_Operation Node26 - -- Package_Instantiation Node26 - -- Storage_Size_Variable Node26 - - -- Current_Use_Clause Node27 - -- Related_Type Node27 - -- Wrapped_Entity Node27 - - -- Extra_Formals Node28 - -- Finalizer Node28 - -- Initialization_Statements Node28 - -- Original_Access_Type Node28 - -- Relative_Deadline_Variable Node28 - -- Underlying_Record_View Node28 - - -- Anonymous_Masters Elist29 - -- BIP_Initialization_Call Node29 - -- Subprograms_For_Type Elist29 - - -- Access_Disp_Table_Elab_Flag Node30 - -- Anonymous_Object Node30 - -- Corresponding_Equality Node30 - -- Hidden_In_Formal_Instance Elist30 - -- Last_Aggregate_Assignment Node30 - -- Static_Initialization Node30 - - -- Activation_Record_Component Node31 - -- Derived_Type_Link Node31 - -- Thunk_Entity Node31 - - -- Corresponding_Function Node32 - -- Corresponding_Procedure Node32 - -- Encapsulating_State Node32 - -- No_Tagged_Streams_Pragma Node32 - - -- Linker_Section_Pragma Node33 - - -- Contract Node34 - - -- Anonymous_Designated_Type Node35 - -- Entry_Max_Queue_Lengths_Array Node35 - -- Import_Pragma Node35 - - -- Validated_Object Node38 - -- Predicated_Parent Node38 - -- Class_Wide_Clone Node38 - - -- Protected_Subprogram Node39 - - -- SPARK_Pragma Node40 - - -- Access_Subprogram_Wrapper Node41 - -- Original_Protected_Subprogram Node41 - -- SPARK_Aux_Pragma Node41 - - --------------------------------------------- - -- Usage of Flags in Defining Entity Nodes -- - --------------------------------------------- - - -- All flags are unique, there is no overlaying, so each flag is physically - -- present in every entity. However, for many of the flags, it only makes - -- sense for them to be set true for certain subsets of entity kinds. See - -- the spec of Einfo for further details. - - -- Is_Inlined_Always Flag1 - -- Is_Hidden_Non_Overridden_Subpgm Flag2 - -- Has_Own_DIC Flag3 - -- Is_Frozen Flag4 - -- Has_Discriminants Flag5 - -- Is_Dispatching_Operation Flag6 - -- Is_Immediately_Visible Flag7 - -- In_Use Flag8 - -- Is_Potentially_Use_Visible Flag9 - -- Is_Public Flag10 - - -- Is_Inlined Flag11 - -- Is_Constrained Flag12 - -- Is_Generic_Type Flag13 - -- Depends_On_Private Flag14 - -- Is_Aliased Flag15 - -- Is_Volatile Flag16 - -- Is_Internal Flag17 - -- Has_Delayed_Freeze Flag18 - -- Is_Abstract_Subprogram Flag19 - -- Is_Concurrent_Record_Type Flag20 - - -- Has_Master_Entity Flag21 - -- Needs_No_Actuals Flag22 - -- Has_Storage_Size_Clause Flag23 - -- Is_Imported Flag24 - -- Is_Limited_Record Flag25 - -- Has_Completion Flag26 - -- Has_Pragma_Controlled Flag27 - -- Is_Statically_Allocated Flag28 - -- Has_Size_Clause Flag29 - -- Has_Task Flag30 - - -- Checks_May_Be_Suppressed Flag31 - -- Kill_Elaboration_Checks Flag32 - -- Kill_Range_Checks Flag33 - -- Has_Independent_Components Flag34 - -- Is_Class_Wide_Equivalent_Type Flag35 - -- Referenced_As_LHS Flag36 - -- Is_Known_Non_Null Flag37 - -- Can_Never_Be_Null Flag38 - -- Has_Default_Aspect Flag39 - -- Body_Needed_For_SAL Flag40 - - -- Treat_As_Volatile Flag41 - -- Is_Controlled_Active Flag42 - -- Has_Controlled_Component Flag43 - -- Is_Pure Flag44 - -- In_Private_Part Flag45 - -- Has_Alignment_Clause Flag46 - -- Has_Exit Flag47 - -- In_Package_Body Flag48 - -- Reachable Flag49 - -- Delay_Subprogram_Descriptors Flag50 - - -- Is_Packed Flag51 - -- Is_Entry_Formal Flag52 - -- Is_Private_Descendant Flag53 - -- Return_Present Flag54 - -- Is_Tagged_Type Flag55 - -- Has_Homonym Flag56 - -- Is_Hidden Flag57 - -- Non_Binary_Modulus Flag58 - -- Is_Preelaborated Flag59 - -- Is_Shared_Passive Flag60 - - -- Is_Remote_Types Flag61 - -- Is_Remote_Call_Interface Flag62 - -- Is_Character_Type Flag63 - -- Is_Intrinsic_Subprogram Flag64 - -- Has_Record_Rep_Clause Flag65 - -- Has_Enumeration_Rep_Clause Flag66 - -- Has_Small_Clause Flag67 - -- Has_Component_Size_Clause Flag68 - -- Is_Access_Constant Flag69 - -- Is_First_Subtype Flag70 - - -- Has_Completion_In_Body Flag71 - -- Has_Unknown_Discriminants Flag72 - -- Is_Child_Unit Flag73 - -- Is_CPP_Class Flag74 - -- Has_Non_Standard_Rep Flag75 - -- Is_Constructor Flag76 - -- Static_Elaboration_Desired Flag77 - -- Is_Tag Flag78 - -- Has_All_Calls_Remote Flag79 - -- Is_Constr_Subt_For_U_Nominal Flag80 - - -- Is_Asynchronous Flag81 - -- Has_Gigi_Rep_Item Flag82 - -- Has_Machine_Radix_Clause Flag83 - -- Machine_Radix_10 Flag84 - -- Is_Atomic Flag85 - -- Has_Atomic_Components Flag86 - -- Has_Volatile_Components Flag87 - -- Discard_Names Flag88 - -- Is_Interrupt_Handler Flag89 - -- Returns_By_Ref Flag90 - - -- Is_Itype Flag91 - -- Size_Known_At_Compile_Time Flag92 - -- Reverse_Storage_Order Flag93 - -- Is_Generic_Actual_Type Flag94 - -- Uses_Sec_Stack Flag95 - -- Warnings_Off Flag96 - -- Is_Controlling_Formal Flag97 - -- Has_Controlling_Result Flag98 - -- Is_Exported Flag99 - -- Has_Specified_Layout Flag100 - - -- Has_Nested_Block_With_Handler Flag101 - -- Is_Called Flag102 - -- Is_Completely_Hidden Flag103 - -- Address_Taken Flag104 - -- Suppress_Initialization Flag105 - -- Is_Limited_Composite Flag106 - -- Is_Private_Composite Flag107 - -- Default_Expressions_Processed Flag108 - -- Is_Non_Static_Subtype Flag109 - -- Has_Out_Or_In_Out_Parameter Flag110 - - -- Is_Formal_Subprogram Flag111 - -- Is_Renaming_Of_Object Flag112 - -- No_Return Flag113 - -- Delay_Cleanups Flag114 - -- Never_Set_In_Source Flag115 - -- Is_Visible_Lib_Unit Flag116 - -- Is_Unchecked_Union Flag117 - -- Is_CUDA_Kernel Flag118 - -- Has_Convention_Pragma Flag119 - -- Has_Primitive_Operations Flag120 - - -- Has_Pragma_Pack Flag121 - -- Is_Bit_Packed_Array Flag122 - -- Has_Unchecked_Union Flag123 - -- Is_Eliminated Flag124 - -- C_Pass_By_Copy Flag125 - -- Is_Instantiated Flag126 - -- Is_Valued_Procedure Flag127 - -- (used for Component_Alignment) Flag128 - -- (used for Component_Alignment) Flag129 - -- Is_Generic_Instance Flag130 - - -- No_Pool_Assigned Flag131 - -- Is_DIC_Procedure Flag132 - -- Has_Inherited_DIC Flag133 - -- Has_Aliased_Components Flag135 - -- No_Strict_Aliasing Flag136 - -- Is_Machine_Code_Subprogram Flag137 - -- Is_Packed_Array_Impl_Type Flag138 - -- Has_Biased_Representation Flag139 - -- Has_Complex_Representation Flag140 - - -- Is_Constr_Subt_For_UN_Aliased Flag141 - -- Has_Missing_Return Flag142 - -- Has_Recursive_Call Flag143 - -- Is_Unsigned_Type Flag144 - -- Strict_Alignment Flag145 - -- Is_Abstract_Type Flag146 - -- Needs_Debug_Info Flag147 - -- Is_Elaboration_Checks_OK_Id Flag148 - -- Is_Compilation_Unit Flag149 - -- Has_Pragma_Elaborate_Body Flag150 - - -- Has_Private_Ancestor Flag151 - -- Entry_Accepted Flag152 - -- Is_Obsolescent Flag153 - -- Has_Per_Object_Constraint Flag154 - -- Has_Private_Declaration Flag155 - -- Referenced Flag156 - -- Has_Pragma_Inline Flag157 - -- Finalize_Storage_Only Flag158 - -- From_Limited_With Flag159 - -- Is_Package_Body_Entity Flag160 - - -- Has_Qualified_Name Flag161 - -- Nonzero_Is_True Flag162 - -- Is_True_Constant Flag163 - -- Reverse_Bit_Order Flag164 - -- Suppress_Style_Checks Flag165 - -- Debug_Info_Off Flag166 - -- Sec_Stack_Needed_For_Return Flag167 - -- Materialize_Entity Flag168 - -- Has_Pragma_Thread_Local_Storage Flag169 - -- Is_Known_Valid Flag170 - - -- Is_Hidden_Open_Scope Flag171 - -- Has_Object_Size_Clause Flag172 - -- Has_Fully_Qualified_Name Flag173 - -- Elaboration_Entity_Required Flag174 - -- Has_Forward_Instantiation Flag175 - -- Is_Discrim_SO_Function Flag176 - -- Size_Depends_On_Discriminant Flag177 - -- Is_Null_Init_Proc Flag178 - -- Has_Pragma_Pure_Function Flag179 - -- Has_Pragma_Unreferenced Flag180 - - -- Has_Contiguous_Rep Flag181 - -- Has_Xref_Entry Flag182 - -- Must_Be_On_Byte_Boundary Flag183 - -- Has_Stream_Size_Clause Flag184 - -- Is_Ada_2005_Only Flag185 - -- Is_Interface Flag186 - -- Has_Constrained_Partial_View Flag187 - -- Uses_Lock_Free Flag188 - -- Is_Pure_Unit_Access_Type Flag189 - -- Has_Specified_Stream_Input Flag190 - - -- Has_Specified_Stream_Output Flag191 - -- Has_Specified_Stream_Read Flag192 - -- Has_Specified_Stream_Write Flag193 - -- Is_Local_Anonymous_Access Flag194 - -- Is_Primitive_Wrapper Flag195 - -- Was_Hidden Flag196 - -- Is_Limited_Interface Flag197 - -- Has_Pragma_Ordered Flag198 - -- Is_Ada_2012_Only Flag199 - - -- Has_Delayed_Aspects Flag200 - -- Has_Pragma_No_Inline Flag201 - -- Itype_Printed Flag202 - -- Has_Pragma_Pure Flag203 - -- Is_Known_Null Flag204 - -- Low_Bound_Tested Flag205 - -- Is_Visible_Formal Flag206 - -- Known_To_Have_Preelab_Init Flag207 - -- Must_Have_Preelab_Init Flag208 - -- Is_Return_Object Flag209 - - -- Elaborate_Body_Desirable Flag210 - -- Has_Static_Discriminants Flag211 - -- Has_Pragma_Unreferenced_Objects Flag212 - -- Requires_Overriding Flag213 - -- Has_RACW Flag214 - -- Is_Param_Block_Component_Type Flag215 - -- Universal_Aliasing Flag216 - -- Suppress_Value_Tracking_On_Call Flag217 - -- Is_Primitive Flag218 - -- Has_Initial_Value Flag219 - - -- Has_Dispatch_Table Flag220 - -- Has_Pragma_Preelab_Init Flag221 - -- Used_As_Generic_Actual Flag222 - -- Is_Descendant_Of_Address Flag223 - -- Is_Raised Flag224 - -- Is_Thunk Flag225 - -- Is_Only_Out_Parameter Flag226 - -- Referenced_As_Out_Parameter Flag227 - -- Has_Thunks Flag228 - -- Can_Use_Internal_Rep Flag229 - - -- Has_Pragma_Inline_Always Flag230 - -- Renamed_In_Spec Flag231 - -- Has_Own_Invariants Flag232 - -- Has_Pragma_Unmodified Flag233 - -- Is_Dispatch_Table_Entity Flag234 - -- Is_Trivial_Subprogram Flag235 - -- Warnings_Off_Used Flag236 - -- Warnings_Off_Used_Unmodified Flag237 - -- Warnings_Off_Used_Unreferenced Flag238 - -- No_Reordering Flag239 - - -- Has_Expanded_Contract Flag240 - -- Optimize_Alignment_Space Flag241 - -- Optimize_Alignment_Time Flag242 - -- Overlays_Constant Flag243 - -- Is_RACW_Stub_Type Flag244 - -- Is_Private_Primitive Flag245 - -- Is_Underlying_Record_View Flag246 - -- OK_To_Rename Flag247 - -- Has_Inheritable_Invariants Flag248 - -- Is_Safe_To_Reevaluate Flag249 - - -- Has_Predicates Flag250 - -- Has_Implicit_Dereference Flag251 - -- Is_Finalized_Transient Flag252 - -- Disable_Controlled Flag253 - -- Is_Implementation_Defined Flag254 - -- Is_Predicate_Function Flag255 - -- Is_Predicate_Function_M Flag256 - -- Is_Invariant_Procedure Flag257 - -- Has_Dynamic_Predicate_Aspect Flag258 - -- Has_Static_Predicate_Aspect Flag259 - - -- Has_Loop_Entry_Attributes Flag260 - -- Has_Delayed_Rep_Aspects Flag261 - -- May_Inherit_Delayed_Rep_Aspects Flag262 - -- Has_Visible_Refinement Flag263 - -- Is_Discriminant_Check_Function Flag264 - -- SPARK_Pragma_Inherited Flag265 - -- SPARK_Aux_Pragma_Inherited Flag266 - -- Has_Shift_Operator Flag267 - -- Is_Independent Flag268 - -- Has_Static_Predicate Flag269 - - -- Stores_Attribute_Old_Prefix Flag270 - -- Has_Protected Flag271 - -- SSO_Set_Low_By_Default Flag272 - -- SSO_Set_High_By_Default Flag273 - -- Is_Generic_Actual_Subprogram Flag274 - -- No_Predicate_On_Actual Flag275 - -- No_Dynamic_Predicate_On_Actual Flag276 - -- Is_Checked_Ghost_Entity Flag277 - -- Is_Ignored_Ghost_Entity Flag278 - -- Contains_Ignored_Ghost_Code Flag279 - - -- Partial_View_Has_Unknown_Discr Flag280 - -- Is_Static_Type Flag281 - -- Has_Nested_Subprogram Flag282 - -- Is_Uplevel_Referenced_Entity Flag283 - -- Is_Unimplemented Flag284 - -- Is_Volatile_Full_Access Flag285 - -- Is_Exception_Handler Flag286 - -- Rewritten_For_C Flag287 - -- Predicates_Ignored Flag288 - -- Has_Timing_Event Flag289 - - -- Is_Class_Wide_Clone Flag290 - -- Has_Inherited_Invariants Flag291 - -- Is_Partial_Invariant_Procedure Flag292 - -- Is_Actual_Subtype Flag293 - -- Has_Pragma_Unused Flag294 - -- Is_Ignored_Transient Flag295 - -- Has_Partial_Visible_Refinement Flag296 - -- Is_Entry_Wrapper Flag297 - -- Is_Underlying_Full_View Flag298 - -- Body_Needed_For_Inlining Flag299 - - -- Has_Private_Extension Flag300 - -- Ignore_SPARK_Mode_Pragmas Flag301 - -- Is_Initial_Condition_Procedure Flag302 - -- Suppress_Elaboration_Warnings Flag303 - -- Is_Elaboration_Warnings_OK_Id Flag304 - -- Is_Activation_Record Flag305 - -- Needs_Activation_Record Flag306 - -- Is_Loop_Parameter Flag307 - -- Has_Yield_Aspect Flag308 - - -- (unused) Flag309 - - -- Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h - - ----------------------- - -- Local subprograms -- - ----------------------- - - function Has_Option - (State_Id : Entity_Id; - Option_Nam : Name_Id) return Boolean; - -- Determine whether abstract state State_Id has particular option denoted - -- by the name Option_Nam. - - --------------- - -- Float_Rep -- - --------------- - - function Float_Rep (Id : E) return F is - pragma Assert (Is_Floating_Point_Type (Id)); - begin - return F'Val (UI_To_Int (Uint10 (Base_Type (Id)))); - end Float_Rep; - - ---------------- - -- Has_Option -- - ---------------- - - function Has_Option - (State_Id : Entity_Id; - Option_Nam : Name_Id) return Boolean - is - Decl : constant Node_Id := Parent (State_Id); - Opt : Node_Id; - Opt_Nam : Node_Id; - - begin - pragma Assert (Ekind (State_Id) = E_Abstract_State); - - -- The declaration of abstract states with options appear as an - -- extension aggregate. If this is not the case, the option is not - -- available. - - if Nkind (Decl) /= N_Extension_Aggregate then - return False; - end if; - - -- Simple options - - Opt := First (Expressions (Decl)); - while Present (Opt) loop - if Nkind (Opt) = N_Identifier and then Chars (Opt) = Option_Nam then - return True; - end if; - - Next (Opt); - end loop; - - -- Complex options with various specifiers - - Opt := First (Component_Associations (Decl)); - while Present (Opt) loop - Opt_Nam := First (Choices (Opt)); - - if Nkind (Opt_Nam) = N_Identifier - and then Chars (Opt_Nam) = Option_Nam - then - return True; - end if; - - Next (Opt); - end loop; - - return False; - end Has_Option; - - -------------------------------- - -- Attribute Access Functions -- - -------------------------------- - - function Abstract_States (Id : E) return L is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id)); - return Elist25 (Id); - end Abstract_States; - - function Accept_Address (Id : E) return L is - begin - return Elist21 (Id); - end Accept_Address; - - function Access_Disp_Table (Id : E) return L is - begin - pragma Assert (Ekind (Id) in E_Record_Subtype - | E_Record_Type - | E_Record_Type_With_Private); - return Elist16 (Implementation_Base_Type (Id)); - end Access_Disp_Table; - - function Access_Disp_Table_Elab_Flag (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Record_Subtype - | E_Record_Type - | E_Record_Type_With_Private); - return Node30 (Implementation_Base_Type (Id)); - end Access_Disp_Table_Elab_Flag; - - function Access_Subprogram_Wrapper (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Subprogram_Type); - return Node41 (Id); - end Access_Subprogram_Wrapper; - - function Activation_Record_Component (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Constant - | E_In_Parameter - | E_In_Out_Parameter - | E_Loop_Parameter - | E_Out_Parameter - | E_Variable); - return Node31 (Id); - end Activation_Record_Component; - - function Actual_Subtype (Id : E) return E is - begin - pragma Assert - (Ekind (Id) in E_Constant | E_Variable | E_Generic_In_Out_Parameter - or else Is_Formal (Id)); - return Node17 (Id); - end Actual_Subtype; - - function Address_Taken (Id : E) return B is - begin - return Flag104 (Id); - end Address_Taken; - - function Alias (Id : E) return E is - begin - pragma Assert - (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type); - return Node18 (Id); - end Alias; - - function Alignment (Id : E) return U is - begin - pragma Assert (Is_Type (Id) - or else Is_Formal (Id) - or else Ekind (Id) in E_Loop_Parameter - | E_Constant - | E_Exception - | E_Variable); - return Uint14 (Id); - end Alignment; - - function Anonymous_Designated_Type (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Variable); - return Node35 (Id); - end Anonymous_Designated_Type; - - function Anonymous_Masters (Id : E) return L is - begin - pragma Assert (Ekind (Id) in E_Function - | E_Package - | E_Procedure - | E_Subprogram_Body); - return Elist29 (Id); - end Anonymous_Masters; - - function Anonymous_Object (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Protected_Type | E_Task_Type); - return Node30 (Id); - end Anonymous_Object; - - function Associated_Entity (Id : E) return E is - begin - return Node37 (Id); - end Associated_Entity; - - function Associated_Formal_Package (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Package); - return Node12 (Id); - end Associated_Formal_Package; - - function Associated_Node_For_Itype (Id : E) return N is - begin - return Node8 (Id); - end Associated_Node_For_Itype; - - function Associated_Storage_Pool (Id : E) return E is - begin - pragma Assert (Is_Access_Type (Id)); - return Node22 (Root_Type (Id)); - end Associated_Storage_Pool; - - function Barrier_Function (Id : E) return N is - begin - pragma Assert (Is_Entry (Id)); - return Node12 (Id); - end Barrier_Function; - - function Block_Node (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Block); - return Node11 (Id); - end Block_Node; - - function Body_Entity (Id : E) return E is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id)); - return Node19 (Id); - end Body_Entity; - - function Body_Needed_For_Inlining (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Package); - return Flag299 (Id); - end Body_Needed_For_Inlining; - - function Body_Needed_For_SAL (Id : E) return B is - begin - pragma Assert - (Ekind (Id) = E_Package - or else Is_Subprogram (Id) - or else Is_Generic_Unit (Id)); - return Flag40 (Id); - end Body_Needed_For_SAL; - - function Body_References (Id : E) return L is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - return Elist16 (Id); - end Body_References; - - function BIP_Initialization_Call (Id : E) return N is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - return Node29 (Id); - end BIP_Initialization_Call; - - function C_Pass_By_Copy (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id)); - return Flag125 (Implementation_Base_Type (Id)); - end C_Pass_By_Copy; - - function Can_Never_Be_Null (Id : E) return B is - begin - return Flag38 (Id); - end Can_Never_Be_Null; - - function Checks_May_Be_Suppressed (Id : E) return B is - begin - return Flag31 (Id); - end Checks_May_Be_Suppressed; - - function Class_Wide_Clone (Id : E) return E is - begin - pragma Assert (Is_Subprogram (Id)); - return Node38 (Id); - end Class_Wide_Clone; - - function Class_Wide_Type (Id : E) return E is - begin - pragma Assert (Is_Type (Id)); - return Node9 (Id); - end Class_Wide_Type; - - function Cloned_Subtype (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Record_Subtype | E_Class_Wide_Subtype); - return Node16 (Id); - end Cloned_Subtype; - - function Component_Bit_Offset (Id : E) return U is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - return Uint11 (Id); - end Component_Bit_Offset; - - function Component_Clause (Id : E) return N is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - return Node13 (Id); - end Component_Clause; - - function Component_Size (Id : E) return U is - begin - pragma Assert (Is_Array_Type (Id)); - return Uint22 (Implementation_Base_Type (Id)); - end Component_Size; - - function Component_Type (Id : E) return E is - begin - pragma Assert (Is_Array_Type (Id)); - return Node20 (Implementation_Base_Type (Id)); - end Component_Type; - - function Corresponding_Concurrent_Type (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Record_Type); - return Node18 (Id); - end Corresponding_Concurrent_Type; - - function Corresponding_Discriminant (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - return Node19 (Id); - end Corresponding_Discriminant; - - function Corresponding_Equality (Id : E) return E is - begin - pragma Assert - (Ekind (Id) = E_Function - and then not Comes_From_Source (Id) - and then Chars (Id) = Name_Op_Ne); - return Node30 (Id); - end Corresponding_Equality; - - function Corresponding_Function (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Procedure); - return Node32 (Id); - end Corresponding_Function; - - function Corresponding_Procedure (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Function); - return Node32 (Id); - end Corresponding_Procedure; - - function Corresponding_Protected_Entry (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Subprogram_Body); - return Node18 (Id); - end Corresponding_Protected_Entry; - - function Corresponding_Record_Component (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - return Node21 (Id); - end Corresponding_Record_Component; - - function Corresponding_Record_Type (Id : E) return E is - begin - pragma Assert (Is_Concurrent_Type (Id)); - return Node18 (Id); - end Corresponding_Record_Type; - - function Corresponding_Remote_Type (Id : E) return E is - begin - return Node22 (Id); - end Corresponding_Remote_Type; - - function Current_Use_Clause (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id)); - return Node27 (Id); - end Current_Use_Clause; - - function Current_Value (Id : E) return N is - begin - pragma Assert (Is_Object (Id)); - return Node9 (Id); - end Current_Value; - - function CR_Discriminant (Id : E) return E is - begin - return Node23 (Id); - end CR_Discriminant; - - function Debug_Info_Off (Id : E) return B is - begin - return Flag166 (Id); - end Debug_Info_Off; - - function Debug_Renaming_Link (Id : E) return E is - begin - return Node25 (Id); - end Debug_Renaming_Link; - - function Default_Aspect_Component_Value (Id : E) return N is - begin - pragma Assert (Is_Array_Type (Id)); - return Node19 (Base_Type (Id)); - end Default_Aspect_Component_Value; - - function Default_Aspect_Value (Id : E) return N is - begin - pragma Assert (Is_Scalar_Type (Id)); - return Node19 (Base_Type (Id)); - end Default_Aspect_Value; - - function Default_Expr_Function (Id : E) return E is - begin - pragma Assert (Is_Formal (Id)); - return Node21 (Id); - end Default_Expr_Function; - - function Default_Expressions_Processed (Id : E) return B is - begin - return Flag108 (Id); - end Default_Expressions_Processed; - - function Default_Value (Id : E) return N is - begin - pragma Assert (Is_Formal (Id)); - return Node20 (Id); - end Default_Value; - - function Delay_Cleanups (Id : E) return B is - begin - return Flag114 (Id); - end Delay_Cleanups; - - function Delay_Subprogram_Descriptors (Id : E) return B is - begin - return Flag50 (Id); - end Delay_Subprogram_Descriptors; - - function Delta_Value (Id : E) return R is - begin - pragma Assert (Is_Fixed_Point_Type (Id)); - return Ureal18 (Id); - end Delta_Value; - - function Dependent_Instances (Id : E) return L is - begin - pragma Assert (Is_Generic_Instance (Id)); - return Elist8 (Id); - end Dependent_Instances; - - function Depends_On_Private (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag14 (Id); - end Depends_On_Private; - - function Derived_Type_Link (Id : E) return E is - begin - pragma Assert (Is_Type (Id)); - return Node31 (Base_Type (Id)); - end Derived_Type_Link; - - function Digits_Value (Id : E) return U is - begin - pragma Assert - (Is_Floating_Point_Type (Id) - or else Is_Decimal_Fixed_Point_Type (Id)); - return Uint17 (Id); - end Digits_Value; - - function Direct_Primitive_Operations (Id : E) return L is - begin - pragma Assert (Is_Tagged_Type (Id)); - return Elist10 (Id); - end Direct_Primitive_Operations; - - function Directly_Designated_Type (Id : E) return E is - begin - pragma Assert (Is_Access_Type (Id)); - return Node20 (Id); - end Directly_Designated_Type; - - function Disable_Controlled (Id : E) return B is - begin - return Flag253 (Base_Type (Id)); - end Disable_Controlled; - - function Discard_Names (Id : E) return B is - begin - return Flag88 (Id); - end Discard_Names; - - function Discriminal (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - return Node17 (Id); - end Discriminal; - - function Discriminal_Link (Id : E) return N is - begin - return Node10 (Id); - end Discriminal_Link; - - function Discriminant_Checking_Func (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Component); - return Node20 (Id); - end Discriminant_Checking_Func; - - function Discriminant_Constraint (Id : E) return L is - begin - pragma Assert - (Is_Composite_Type (Id) - and then (Has_Discriminants (Id) or else Is_Constrained (Id))); - return Elist21 (Id); - end Discriminant_Constraint; - - function Discriminant_Default_Value (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - return Node20 (Id); - end Discriminant_Default_Value; - - function Discriminant_Number (Id : E) return U is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - return Uint15 (Id); - end Discriminant_Number; - - function Dispatch_Table_Wrappers (Id : E) return L is - begin - pragma Assert (Ekind (Id) in E_Record_Type | E_Record_Subtype); - return Elist26 (Implementation_Base_Type (Id)); - end Dispatch_Table_Wrappers; - - function DT_Entry_Count (Id : E) return U is - begin - pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id)); - return Uint15 (Id); - end DT_Entry_Count; - - function DT_Offset_To_Top_Func (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id)); - return Node25 (Id); - end DT_Offset_To_Top_Func; - - function DT_Position (Id : E) return U is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure - and then Present (DTC_Entity (Id))); - return Uint15 (Id); - end DT_Position; - - function DTC_Entity (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Node16 (Id); - end DTC_Entity; - - function Elaborate_Body_Desirable (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Package); - return Flag210 (Id); - end Elaborate_Body_Desirable; - - function Elaboration_Entity (Id : E) return E is - begin - pragma Assert - (Is_Subprogram (Id) - or else - Ekind (Id) in E_Entry | E_Entry_Family | E_Package - or else - Is_Generic_Unit (Id)); - return Node13 (Id); - end Elaboration_Entity; - - function Elaboration_Entity_Required (Id : E) return B is - begin - pragma Assert - (Is_Subprogram (Id) - or else - Ekind (Id) in E_Entry | E_Entry_Family | E_Package - or else - Is_Generic_Unit (Id)); - return Flag174 (Id); - end Elaboration_Entity_Required; - - function Encapsulating_State (Id : E) return N is - begin - pragma Assert (Ekind (Id) in E_Abstract_State | E_Constant | E_Variable); - return Node32 (Id); - end Encapsulating_State; - - function Enclosing_Scope (Id : E) return E is - begin - return Node18 (Id); - end Enclosing_Scope; - - function Entry_Accepted (Id : E) return B is - begin - pragma Assert (Is_Entry (Id)); - return Flag152 (Id); - end Entry_Accepted; - - function Entry_Bodies_Array (Id : E) return E is - begin - return Node19 (Id); - end Entry_Bodies_Array; - - function Entry_Cancel_Parameter (Id : E) return E is - begin - return Node23 (Id); - end Entry_Cancel_Parameter; - - function Entry_Component (Id : E) return E is - begin - return Node11 (Id); - end Entry_Component; - - function Entry_Formal (Id : E) return E is - begin - return Node16 (Id); - end Entry_Formal; - - function Entry_Index_Constant (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Entry_Index_Parameter); - return Node18 (Id); - end Entry_Index_Constant; - - function Entry_Max_Queue_Lengths_Array (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Protected_Type); - return Node35 (Id); - end Entry_Max_Queue_Lengths_Array; - - function Contains_Ignored_Ghost_Code (Id : E) return B is - begin - pragma Assert - (Ekind (Id) in E_Block - | E_Function - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Package - | E_Package_Body - | E_Procedure - | E_Subprogram_Body); - return Flag279 (Id); - end Contains_Ignored_Ghost_Code; - - function Contract (Id : E) return N is - begin - pragma Assert - (Ekind (Id) in E_Protected_Type -- concurrent types - | E_Task_Body - | E_Task_Type - or else - Ekind (Id) in E_Constant -- objects - | E_Variable - or else - Ekind (Id) in E_Entry -- overloadable - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body - or else - Is_Type (Id) -- types - or else - Ekind (Id) = E_Void); -- special purpose - return Node34 (Id); - end Contract; - - function Contract_Wrapper (Id : E) return E is - begin - pragma Assert (Is_Entry (Id)); - return Node25 (Id); - end Contract_Wrapper; - - function Entry_Parameters_Type (Id : E) return E is - begin - return Node15 (Id); - end Entry_Parameters_Type; - - function Enum_Pos_To_Rep (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Type); - return Node23 (Id); - end Enum_Pos_To_Rep; - - function Enumeration_Pos (Id : E) return Uint is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Literal); - return Uint11 (Id); - end Enumeration_Pos; - - function Enumeration_Rep (Id : E) return U is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Literal); - return Uint12 (Id); - end Enumeration_Rep; - - function Enumeration_Rep_Expr (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Literal); - return Node22 (Id); - end Enumeration_Rep_Expr; - - function Equivalent_Type (Id : E) return E is - begin - pragma Assert - (Ekind (Id) in E_Class_Wide_Type - | E_Class_Wide_Subtype - | E_Access_Subprogram_Type - | E_Access_Protected_Subprogram_Type - | E_Anonymous_Access_Protected_Subprogram_Type - | E_Exception_Type); - return Node18 (Id); - end Equivalent_Type; - - function Esize (Id : E) return Uint is - begin - return Uint12 (Id); - end Esize; - - function Extra_Accessibility (Id : E) return E is - begin - pragma Assert - (Is_Formal (Id) or else Ekind (Id) in E_Variable | E_Constant); - return Node13 (Id); - end Extra_Accessibility; - - function Extra_Accessibility_Of_Result (Id : E) return E is - begin - pragma Assert - (Ekind (Id) in E_Function | E_Operator | E_Subprogram_Type); - return Node19 (Id); - end Extra_Accessibility_Of_Result; - - function Extra_Constrained (Id : E) return E is - begin - pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable); - return Node23 (Id); - end Extra_Constrained; - - function Extra_Formal (Id : E) return E is - begin - return Node15 (Id); - end Extra_Formal; - - function Extra_Formals (Id : E) return E is - begin - pragma Assert - (Is_Overloadable (Id) - or else Ekind (Id) in E_Entry_Family - | E_Subprogram_Body - | E_Subprogram_Type); - return Node28 (Id); - end Extra_Formals; - - function Can_Use_Internal_Rep (Id : E) return B is - begin - pragma Assert (Is_Access_Subprogram_Type (Base_Type (Id))); - return Flag229 (Base_Type (Id)); - end Can_Use_Internal_Rep; - - function Finalization_Master (Id : E) return E is - begin - pragma Assert (Is_Access_Type (Id)); - return Node23 (Root_Type (Id)); - end Finalization_Master; - - function Finalize_Storage_Only (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag158 (Base_Type (Id)); - end Finalize_Storage_Only; - - function Finalizer (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Package | E_Package_Body); - return Node28 (Id); - end Finalizer; - - function First_Entity (Id : E) return E is - begin - return Node17 (Id); - end First_Entity; - - function First_Exit_Statement (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Loop); - return Node8 (Id); - end First_Exit_Statement; - - function First_Index (Id : E) return N is - begin - pragma Assert (Is_Array_Type (Id)); - return Node17 (Id); - end First_Index; - - function First_Literal (Id : E) return E is - begin - pragma Assert (Is_Enumeration_Type (Id)); - return Node17 (Id); - end First_Literal; - - function First_Private_Entity (Id : E) return E is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id) - or else Is_Concurrent_Type (Id)); - return Node16 (Id); - end First_Private_Entity; - - function First_Rep_Item (Id : E) return E is - begin - return Node6 (Id); - end First_Rep_Item; - - function Freeze_Node (Id : E) return N is - begin - return Node7 (Id); - end Freeze_Node; - - function From_Limited_With (Id : E) return B is - begin - return Flag159 (Id); - end From_Limited_With; - - function Full_View (Id : E) return E is - begin - pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant); - return Node11 (Id); - end Full_View; - - function Generic_Homonym (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Generic_Package); - return Node11 (Id); - end Generic_Homonym; - - function Generic_Renamings (Id : E) return L is - begin - return Elist23 (Id); - end Generic_Renamings; - - function Handler_Records (Id : E) return S is - begin - return List10 (Id); - end Handler_Records; - - function Has_Aliased_Components (Id : E) return B is - begin - return Flag135 (Implementation_Base_Type (Id)); - end Has_Aliased_Components; - - function Has_Alignment_Clause (Id : E) return B is - begin - return Flag46 (Id); - end Has_Alignment_Clause; - - function Has_All_Calls_Remote (Id : E) return B is - begin - return Flag79 (Id); - end Has_All_Calls_Remote; - - function Has_Atomic_Components (Id : E) return B is - begin - return Flag86 (Implementation_Base_Type (Id)); - end Has_Atomic_Components; - - function Has_Biased_Representation (Id : E) return B is - begin - return Flag139 (Id); - end Has_Biased_Representation; - - function Has_Completion (Id : E) return B is - begin - return Flag26 (Id); - end Has_Completion; - - function Has_Completion_In_Body (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag71 (Id); - end Has_Completion_In_Body; - - function Has_Complex_Representation (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id)); - return Flag140 (Implementation_Base_Type (Id)); - end Has_Complex_Representation; - - function Has_Component_Size_Clause (Id : E) return B is - begin - pragma Assert (Is_Array_Type (Id)); - return Flag68 (Implementation_Base_Type (Id)); - end Has_Component_Size_Clause; - - function Has_Constrained_Partial_View (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag187 (Base_Type (Id)); - end Has_Constrained_Partial_View; - - function Has_Controlled_Component (Id : E) return B is - begin - return Flag43 (Base_Type (Id)); - end Has_Controlled_Component; - - function Has_Contiguous_Rep (Id : E) return B is - begin - return Flag181 (Id); - end Has_Contiguous_Rep; - - function Has_Controlling_Result (Id : E) return B is - begin - return Flag98 (Id); - end Has_Controlling_Result; - - function Has_Convention_Pragma (Id : E) return B is - begin - return Flag119 (Id); - end Has_Convention_Pragma; - - function Has_Default_Aspect (Id : E) return B is - begin - return Flag39 (Base_Type (Id)); - end Has_Default_Aspect; - - function Has_Delayed_Aspects (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag200 (Id); - end Has_Delayed_Aspects; - - function Has_Delayed_Freeze (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag18 (Id); - end Has_Delayed_Freeze; - - function Has_Delayed_Rep_Aspects (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag261 (Id); - end Has_Delayed_Rep_Aspects; - - function Has_Discriminants (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag5 (Id); - end Has_Discriminants; - - function Has_Dispatch_Table (Id : E) return B is - begin - pragma Assert (Is_Tagged_Type (Id)); - return Flag220 (Id); - end Has_Dispatch_Table; - - function Has_Dynamic_Predicate_Aspect (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag258 (Id); - end Has_Dynamic_Predicate_Aspect; - - function Has_Enumeration_Rep_Clause (Id : E) return B is - begin - pragma Assert (Is_Enumeration_Type (Id)); - return Flag66 (Id); - end Has_Enumeration_Rep_Clause; - - function Has_Exit (Id : E) return B is - begin - return Flag47 (Id); - end Has_Exit; - - function Has_Expanded_Contract (Id : E) return B is - begin - pragma Assert (Is_Subprogram (Id)); - return Flag240 (Id); - end Has_Expanded_Contract; - - function Has_Forward_Instantiation (Id : E) return B is - begin - return Flag175 (Id); - end Has_Forward_Instantiation; - - function Has_Fully_Qualified_Name (Id : E) return B is - begin - return Flag173 (Id); - end Has_Fully_Qualified_Name; - - function Has_Gigi_Rep_Item (Id : E) return B is - begin - return Flag82 (Id); - end Has_Gigi_Rep_Item; - - function Has_Homonym (Id : E) return B is - begin - return Flag56 (Id); - end Has_Homonym; - - function Has_Implicit_Dereference (Id : E) return B is - begin - return Flag251 (Id); - end Has_Implicit_Dereference; - - function Has_Independent_Components (Id : E) return B is - begin - return Flag34 (Implementation_Base_Type (Id)); - end Has_Independent_Components; - - function Has_Inheritable_Invariants (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag248 (Base_Type (Id)); - end Has_Inheritable_Invariants; - - function Has_Inherited_DIC (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag133 (Base_Type (Id)); - end Has_Inherited_DIC; - - function Has_Inherited_Invariants (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag291 (Base_Type (Id)); - end Has_Inherited_Invariants; - - function Has_Initial_Value (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Variable or else Is_Formal (Id)); - return Flag219 (Id); - end Has_Initial_Value; - - function Has_Loop_Entry_Attributes (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Loop); - return Flag260 (Id); - end Has_Loop_Entry_Attributes; - - function Has_Machine_Radix_Clause (Id : E) return B is - begin - pragma Assert (Is_Decimal_Fixed_Point_Type (Id)); - return Flag83 (Id); - end Has_Machine_Radix_Clause; - - function Has_Master_Entity (Id : E) return B is - begin - return Flag21 (Id); - end Has_Master_Entity; - - function Has_Missing_Return (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Generic_Function); - return Flag142 (Id); - end Has_Missing_Return; - - function Has_Nested_Block_With_Handler (Id : E) return B is - begin - return Flag101 (Id); - end Has_Nested_Block_With_Handler; - - function Has_Nested_Subprogram (Id : E) return B is - begin - pragma Assert (Is_Subprogram (Id)); - return Flag282 (Id); - end Has_Nested_Subprogram; - - function Has_Non_Standard_Rep (Id : E) return B is - begin - return Flag75 (Implementation_Base_Type (Id)); - end Has_Non_Standard_Rep; - - function Has_Object_Size_Clause (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag172 (Id); - end Has_Object_Size_Clause; - - function Has_Out_Or_In_Out_Parameter (Id : E) return B is - begin - pragma Assert - (Is_Entry (Id) or else Is_Subprogram_Or_Generic_Subprogram (Id)); - return Flag110 (Id); - end Has_Out_Or_In_Out_Parameter; - - function Has_Own_DIC (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag3 (Base_Type (Id)); - end Has_Own_DIC; - - function Has_Own_Invariants (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag232 (Base_Type (Id)); - end Has_Own_Invariants; - - function Has_Partial_Visible_Refinement (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - return Flag296 (Id); - end Has_Partial_Visible_Refinement; - - function Has_Per_Object_Constraint (Id : E) return B is - begin - return Flag154 (Id); - end Has_Per_Object_Constraint; - - function Has_Pragma_Controlled (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag27 (Implementation_Base_Type (Id)); - end Has_Pragma_Controlled; - - function Has_Pragma_Elaborate_Body (Id : E) return B is - begin - return Flag150 (Id); - end Has_Pragma_Elaborate_Body; - - function Has_Pragma_Inline (Id : E) return B is - begin - return Flag157 (Id); - end Has_Pragma_Inline; - - function Has_Pragma_Inline_Always (Id : E) return B is - begin - return Flag230 (Id); - end Has_Pragma_Inline_Always; - - function Has_Pragma_No_Inline (Id : E) return B is - begin - return Flag201 (Id); - end Has_Pragma_No_Inline; - - function Has_Pragma_Ordered (Id : E) return B is - begin - pragma Assert (Is_Enumeration_Type (Id)); - return Flag198 (Implementation_Base_Type (Id)); - end Has_Pragma_Ordered; - - function Has_Pragma_Pack (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id)); - return Flag121 (Implementation_Base_Type (Id)); - end Has_Pragma_Pack; - - function Has_Pragma_Preelab_Init (Id : E) return B is - begin - return Flag221 (Id); - end Has_Pragma_Preelab_Init; - - function Has_Pragma_Pure (Id : E) return B is - begin - return Flag203 (Id); - end Has_Pragma_Pure; - - function Has_Pragma_Pure_Function (Id : E) return B is - begin - return Flag179 (Id); - end Has_Pragma_Pure_Function; - - function Has_Pragma_Thread_Local_Storage (Id : E) return B is - begin - return Flag169 (Id); - end Has_Pragma_Thread_Local_Storage; - - function Has_Pragma_Unmodified (Id : E) return B is - begin - return Flag233 (Id); - end Has_Pragma_Unmodified; - - function Has_Pragma_Unreferenced (Id : E) return B is - begin - return Flag180 (Id); - end Has_Pragma_Unreferenced; - - function Has_Pragma_Unreferenced_Objects (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag212 (Id); - end Has_Pragma_Unreferenced_Objects; - - function Has_Pragma_Unused (Id : E) return B is - begin - return Flag294 (Id); - end Has_Pragma_Unused; - - function Has_Predicates (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag250 (Id); - end Has_Predicates; - - function Has_Primitive_Operations (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag120 (Base_Type (Id)); - end Has_Primitive_Operations; - - function Has_Private_Ancestor (Id : E) return B is - begin - return Flag151 (Id); - end Has_Private_Ancestor; - - function Has_Private_Declaration (Id : E) return B is - begin - return Flag155 (Id); - end Has_Private_Declaration; - - function Has_Private_Extension (Id : E) return B is - begin - pragma Assert (Is_Tagged_Type (Id)); - return Flag300 (Id); - end Has_Private_Extension; - - function Has_Protected (Id : E) return B is - begin - return Flag271 (Base_Type (Id)); - end Has_Protected; - - function Has_Qualified_Name (Id : E) return B is - begin - return Flag161 (Id); - end Has_Qualified_Name; - - function Has_RACW (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Package); - return Flag214 (Id); - end Has_RACW; - - function Has_Record_Rep_Clause (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id)); - return Flag65 (Implementation_Base_Type (Id)); - end Has_Record_Rep_Clause; - - function Has_Recursive_Call (Id : E) return B is - begin - pragma Assert (Is_Subprogram (Id)); - return Flag143 (Id); - end Has_Recursive_Call; - - function Has_Shift_Operator (Id : E) return B is - begin - pragma Assert (Is_Integer_Type (Id)); - return Flag267 (Base_Type (Id)); - end Has_Shift_Operator; - - function Has_Size_Clause (Id : E) return B is - begin - return Flag29 (Id); - end Has_Size_Clause; - - function Has_Small_Clause (Id : E) return B is - begin - pragma Assert (Is_Ordinary_Fixed_Point_Type (Id)); - return Flag67 (Id); - end Has_Small_Clause; - - function Has_Specified_Layout (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag100 (Implementation_Base_Type (Id)); - end Has_Specified_Layout; - - function Has_Specified_Stream_Input (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag190 (Id); - end Has_Specified_Stream_Input; - - function Has_Specified_Stream_Output (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag191 (Id); - end Has_Specified_Stream_Output; - - function Has_Specified_Stream_Read (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag192 (Id); - end Has_Specified_Stream_Read; - - function Has_Specified_Stream_Write (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag193 (Id); - end Has_Specified_Stream_Write; - - function Has_Static_Discriminants (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag211 (Id); - end Has_Static_Discriminants; - - function Has_Static_Predicate (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag269 (Id); - end Has_Static_Predicate; - - function Has_Static_Predicate_Aspect (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag259 (Id); - end Has_Static_Predicate_Aspect; - - function Has_Storage_Size_Clause (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id)); - return Flag23 (Implementation_Base_Type (Id)); - end Has_Storage_Size_Clause; - - function Has_Stream_Size_Clause (Id : E) return B is - begin - return Flag184 (Id); - end Has_Stream_Size_Clause; - - function Has_Task (Id : E) return B is - begin - return Flag30 (Base_Type (Id)); - end Has_Task; - - function Has_Thunks (Id : E) return B is - begin - return Flag228 (Id); - end Has_Thunks; - - function Has_Timing_Event (Id : E) return B is - begin - return Flag289 (Base_Type (Id)); - end Has_Timing_Event; - - function Has_Unchecked_Union (Id : E) return B is - begin - return Flag123 (Base_Type (Id)); - end Has_Unchecked_Union; - - function Has_Unknown_Discriminants (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag72 (Id); - end Has_Unknown_Discriminants; - - function Has_Visible_Refinement (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - return Flag263 (Id); - end Has_Visible_Refinement; - - function Has_Volatile_Components (Id : E) return B is - begin - return Flag87 (Implementation_Base_Type (Id)); - end Has_Volatile_Components; - - function Has_Xref_Entry (Id : E) return B is - begin - return Flag182 (Id); - end Has_Xref_Entry; - - function Has_Yield_Aspect (Id : E) return B is - begin - return Flag308 (Id); - end Has_Yield_Aspect; - - function Hiding_Loop_Variable (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Variable); - return Node8 (Id); - end Hiding_Loop_Variable; - - function Hidden_In_Formal_Instance (Id : E) return L is - begin - pragma Assert (Ekind (Id) = E_Package); - return Elist30 (Id); - end Hidden_In_Formal_Instance; - - function Homonym (Id : E) return E is - begin - return Node4 (Id); - end Homonym; - - function Ignore_SPARK_Mode_Pragmas (Id : E) return B is - begin - pragma Assert - (Ekind (Id) in E_Protected_Body -- concurrent types - | E_Protected_Type - | E_Task_Body - | E_Task_Type - or else - Ekind (Id) in E_Entry -- overloadable - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body); - return Flag301 (Id); - end Ignore_SPARK_Mode_Pragmas; - - function Import_Pragma (Id : E) return E is - begin - pragma Assert (Is_Subprogram (Id)); - return Node35 (Id); - end Import_Pragma; - - function Incomplete_Actuals (Id : E) return L is - begin - pragma Assert (Ekind (Id) = E_Package); - return Elist24 (Id); - end Incomplete_Actuals; - - function Interface_Alias (Id : E) return E is - begin - pragma Assert (Is_Subprogram (Id)); - return Node25 (Id); - end Interface_Alias; - - function Interfaces (Id : E) return L is - begin - pragma Assert (Is_Record_Type (Id)); - return Elist25 (Id); - end Interfaces; - - function In_Package_Body (Id : E) return B is - begin - return Flag48 (Id); - end In_Package_Body; - - function In_Private_Part (Id : E) return B is - begin - return Flag45 (Id); - end In_Private_Part; - - function In_Use (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag8 (Id); - end In_Use; - - function Initialization_Statements (Id : E) return N is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - return Node28 (Id); - end Initialization_Statements; - - function Inner_Instances (Id : E) return L is - begin - return Elist23 (Id); - end Inner_Instances; - - function Interface_Name (Id : E) return N is - begin - return Node21 (Id); - end Interface_Name; - - function Is_Abstract_Subprogram (Id : E) return B is - begin - pragma Assert (Is_Overloadable (Id)); - return Flag19 (Id); - end Is_Abstract_Subprogram; - - function Is_Abstract_Type (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag146 (Id); - end Is_Abstract_Type; - - function Is_Access_Constant (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag69 (Id); - end Is_Access_Constant; - - function Is_Activation_Record (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_In_Parameter); - return Flag305 (Id); - end Is_Activation_Record; - - function Is_Actual_Subtype (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag293 (Id); - end Is_Actual_Subtype; - - function Is_Ada_2005_Only (Id : E) return B is - begin - return Flag185 (Id); - end Is_Ada_2005_Only; - - function Is_Ada_2012_Only (Id : E) return B is - begin - return Flag199 (Id); - end Is_Ada_2012_Only; - - function Is_Aliased (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag15 (Id); - end Is_Aliased; - - function Is_Asynchronous (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id)); - return Flag81 (Id); - end Is_Asynchronous; - - function Is_Atomic (Id : E) return B is - begin - return Flag85 (Id); - end Is_Atomic; - - function Is_Bit_Packed_Array (Id : E) return B is - begin - return Flag122 (Implementation_Base_Type (Id)); - end Is_Bit_Packed_Array; - - function Is_Called (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Procedure | E_Function | E_Package); - return Flag102 (Id); - end Is_Called; - - function Is_Character_Type (Id : E) return B is - begin - return Flag63 (Id); - end Is_Character_Type; - - function Is_Checked_Ghost_Entity (Id : E) return B is - begin - -- Allow this attribute to appear on unanalyzed entities - - pragma Assert (Nkind (Id) in N_Entity - or else Ekind (Id) = E_Void); - return Flag277 (Id); - end Is_Checked_Ghost_Entity; - - function Is_Child_Unit (Id : E) return B is - begin - return Flag73 (Id); - end Is_Child_Unit; - - function Is_Class_Wide_Clone (Id : E) return B is - begin - return Flag290 (Id); - end Is_Class_Wide_Clone; - - function Is_Class_Wide_Equivalent_Type (Id : E) return B is - begin - return Flag35 (Id); - end Is_Class_Wide_Equivalent_Type; - - function Is_Compilation_Unit (Id : E) return B is - begin - return Flag149 (Id); - end Is_Compilation_Unit; - - function Is_Completely_Hidden (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - return Flag103 (Id); - end Is_Completely_Hidden; - - function Is_Constr_Subt_For_U_Nominal (Id : E) return B is - begin - return Flag80 (Id); - end Is_Constr_Subt_For_U_Nominal; - - function Is_Constr_Subt_For_UN_Aliased (Id : E) return B is - begin - return Flag141 (Id); - end Is_Constr_Subt_For_UN_Aliased; - - function Is_Constrained (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag12 (Id); - end Is_Constrained; - - function Is_Constructor (Id : E) return B is - begin - return Flag76 (Id); - end Is_Constructor; - - function Is_Controlled_Active (Id : E) return B is - begin - return Flag42 (Base_Type (Id)); - end Is_Controlled_Active; - - function Is_Controlling_Formal (Id : E) return B is - begin - pragma Assert (Is_Formal (Id)); - return Flag97 (Id); - end Is_Controlling_Formal; - - function Is_CPP_Class (Id : E) return B is - begin - return Flag74 (Id); - end Is_CPP_Class; - - function Is_CUDA_Kernel (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag118 (Id); - end Is_CUDA_Kernel; - - function Is_DIC_Procedure (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag132 (Id); - end Is_DIC_Procedure; - - function Is_Descendant_Of_Address (Id : E) return B is - begin - return Flag223 (Id); - end Is_Descendant_Of_Address; - - function Is_Discrim_SO_Function (Id : E) return B is - begin - return Flag176 (Id); - end Is_Discrim_SO_Function; - - function Is_Discriminant_Check_Function (Id : E) return B is - begin - return Flag264 (Id); - end Is_Discriminant_Check_Function; - - function Is_Dispatch_Table_Entity (Id : E) return B is - begin - return Flag234 (Id); - end Is_Dispatch_Table_Entity; - - function Is_Dispatching_Operation (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag6 (Id); - end Is_Dispatching_Operation; - - function Is_Elaboration_Checks_OK_Id (Id : E) return B is - begin - pragma Assert (Is_Elaboration_Target (Id)); - return Flag148 (Id); - end Is_Elaboration_Checks_OK_Id; - - function Is_Elaboration_Warnings_OK_Id (Id : E) return B is - begin - pragma Assert (Is_Elaboration_Target (Id) or else Ekind (Id) = E_Void); - return Flag304 (Id); - end Is_Elaboration_Warnings_OK_Id; - - function Is_Eliminated (Id : E) return B is - begin - return Flag124 (Id); - end Is_Eliminated; - - function Is_Entry_Formal (Id : E) return B is - begin - return Flag52 (Id); - end Is_Entry_Formal; - - function Is_Entry_Wrapper (Id : E) return B is - begin - return Flag297 (Id); - end Is_Entry_Wrapper; - - function Is_Exception_Handler (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Block); - return Flag286 (Id); - end Is_Exception_Handler; - - function Is_Exported (Id : E) return B is - begin - return Flag99 (Id); - end Is_Exported; - - function Is_Finalized_Transient (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Loop_Parameter | E_Variable); - return Flag252 (Id); - end Is_Finalized_Transient; - - function Is_First_Subtype (Id : E) return B is - begin - return Flag70 (Id); - end Is_First_Subtype; - - function Is_Formal_Subprogram (Id : E) return B is - begin - return Flag111 (Id); - end Is_Formal_Subprogram; - - function Is_Frozen (Id : E) return B is - begin - return Flag4 (Id); - end Is_Frozen; - - function Is_Generic_Actual_Subprogram (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag274 (Id); - end Is_Generic_Actual_Subprogram; - - function Is_Generic_Actual_Type (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag94 (Id); - end Is_Generic_Actual_Type; - - function Is_Generic_Instance (Id : E) return B is - begin - return Flag130 (Id); - end Is_Generic_Instance; - - function Is_Generic_Type (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag13 (Id); - end Is_Generic_Type; - - function Is_Hidden (Id : E) return B is - begin - return Flag57 (Id); - end Is_Hidden; - - function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B is - begin - return Flag2 (Id); - end Is_Hidden_Non_Overridden_Subpgm; - - function Is_Hidden_Open_Scope (Id : E) return B is - begin - return Flag171 (Id); - end Is_Hidden_Open_Scope; - - function Is_Ignored_Ghost_Entity (Id : E) return B is - begin - -- Allow this attribute to appear on unanalyzed entities - - pragma Assert (Nkind (Id) in N_Entity - or else Ekind (Id) = E_Void); - return Flag278 (Id); - end Is_Ignored_Ghost_Entity; - - function Is_Ignored_Transient (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Loop_Parameter | E_Variable); - return Flag295 (Id); - end Is_Ignored_Transient; - - function Is_Immediately_Visible (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag7 (Id); - end Is_Immediately_Visible; - - function Is_Implementation_Defined (Id : E) return B is - begin - return Flag254 (Id); - end Is_Implementation_Defined; - - function Is_Imported (Id : E) return B is - begin - return Flag24 (Id); - end Is_Imported; - - function Is_Independent (Id : E) return B is - begin - return Flag268 (Id); - end Is_Independent; - - function Is_Initial_Condition_Procedure (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag302 (Id); - end Is_Initial_Condition_Procedure; - - function Is_Inlined (Id : E) return B is - begin - return Flag11 (Id); - end Is_Inlined; - - function Is_Inlined_Always (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag1 (Id); - end Is_Inlined_Always; - - function Is_Interface (Id : E) return B is - begin - return Flag186 (Id); - end Is_Interface; - - function Is_Instantiated (Id : E) return B is - begin - return Flag126 (Id); - end Is_Instantiated; - - function Is_Internal (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag17 (Id); - end Is_Internal; - - function Is_Interrupt_Handler (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag89 (Id); - end Is_Interrupt_Handler; - - function Is_Intrinsic_Subprogram (Id : E) return B is - begin - return Flag64 (Id); - end Is_Intrinsic_Subprogram; - - function Is_Invariant_Procedure (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag257 (Id); - end Is_Invariant_Procedure; - - function Is_Itype (Id : E) return B is - begin - return Flag91 (Id); - end Is_Itype; - - function Is_Known_Non_Null (Id : E) return B is - begin - return Flag37 (Id); - end Is_Known_Non_Null; - - function Is_Known_Null (Id : E) return B is - begin - return Flag204 (Id); - end Is_Known_Null; - - function Is_Known_Valid (Id : E) return B is - begin - return Flag170 (Id); - end Is_Known_Valid; - - function Is_Limited_Composite (Id : E) return B is - begin - return Flag106 (Id); - end Is_Limited_Composite; - - function Is_Limited_Interface (Id : E) return B is - begin - return Flag197 (Id); - end Is_Limited_Interface; - - function Is_Limited_Record (Id : E) return B is - begin - return Flag25 (Id); - end Is_Limited_Record; - - function Is_Local_Anonymous_Access (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag194 (Id); - end Is_Local_Anonymous_Access; - - function Is_Loop_Parameter (Id : E) return B is - begin - return Flag307 (Id); - end Is_Loop_Parameter; - - function Is_Machine_Code_Subprogram (Id : E) return B is - begin - pragma Assert (Is_Subprogram (Id)); - return Flag137 (Id); - end Is_Machine_Code_Subprogram; - - function Is_Non_Static_Subtype (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag109 (Id); - end Is_Non_Static_Subtype; - - function Is_Null_Init_Proc (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Procedure); - return Flag178 (Id); - end Is_Null_Init_Proc; - - function Is_Obsolescent (Id : E) return B is - begin - return Flag153 (Id); - end Is_Obsolescent; - - function Is_Only_Out_Parameter (Id : E) return B is - begin - pragma Assert (Is_Formal (Id)); - return Flag226 (Id); - end Is_Only_Out_Parameter; - - function Is_Package_Body_Entity (Id : E) return B is - begin - return Flag160 (Id); - end Is_Package_Body_Entity; - - function Is_Packed (Id : E) return B is - begin - return Flag51 (Implementation_Base_Type (Id)); - end Is_Packed; - - function Is_Packed_Array_Impl_Type (Id : E) return B is - begin - return Flag138 (Id); - end Is_Packed_Array_Impl_Type; - - function Is_Param_Block_Component_Type (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag215 (Base_Type (Id)); - end Is_Param_Block_Component_Type; - - function Is_Partial_DIC_Procedure (Id : E) return B is - Partial_DIC_Suffix : constant String := "Partial_DIC"; - DIC_Nam : constant String := Get_Name_String (Chars (Id)); - - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - - -- Instead of adding a new Entity_Id flag (which are in short supply), - -- we test the form of the subprogram name. When the node field and flag - -- situation is eased, this should be replaced with a flag. ??? - - if DIC_Nam'Length > Partial_DIC_Suffix'Length - and then - DIC_Nam - (DIC_Nam'Last - Partial_DIC_Suffix'Length + 1 .. DIC_Nam'Last) = - Partial_DIC_Suffix - then - return True; - else - return False; - end if; - end Is_Partial_DIC_Procedure; - - function Is_Partial_Invariant_Procedure (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag292 (Id); - end Is_Partial_Invariant_Procedure; - - function Is_Potentially_Use_Visible (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag9 (Id); - end Is_Potentially_Use_Visible; - - function Is_Predicate_Function (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag255 (Id); - end Is_Predicate_Function; - - function Is_Predicate_Function_M (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag256 (Id); - end Is_Predicate_Function_M; - - function Is_Preelaborated (Id : E) return B is - begin - return Flag59 (Id); - end Is_Preelaborated; - - function Is_Primitive (Id : E) return B is - begin - pragma Assert (Is_Overloadable (Id) or else Is_Generic_Subprogram (Id)); - return Flag218 (Id); - end Is_Primitive; - - function Is_Primitive_Wrapper (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag195 (Id); - end Is_Primitive_Wrapper; - - function Is_Private_Composite (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag107 (Id); - end Is_Private_Composite; - - function Is_Private_Descendant (Id : E) return B is - begin - return Flag53 (Id); - end Is_Private_Descendant; - - function Is_Private_Primitive (Id : E) return B is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Flag245 (Id); - end Is_Private_Primitive; - - function Is_Public (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag10 (Id); - end Is_Public; - - function Is_Pure (Id : E) return B is - begin - return Flag44 (Id); - end Is_Pure; - - function Is_Pure_Unit_Access_Type (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag189 (Id); - end Is_Pure_Unit_Access_Type; - - function Is_RACW_Stub_Type (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag244 (Id); - end Is_RACW_Stub_Type; - - function Is_Raised (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Exception); - return Flag224 (Id); - end Is_Raised; - - function Is_Remote_Call_Interface (Id : E) return B is - begin - return Flag62 (Id); - end Is_Remote_Call_Interface; - - function Is_Remote_Types (Id : E) return B is - begin - return Flag61 (Id); - end Is_Remote_Types; - - function Is_Renaming_Of_Object (Id : E) return B is - begin - return Flag112 (Id); - end Is_Renaming_Of_Object; - - function Is_Return_Object (Id : E) return B is - begin - return Flag209 (Id); - end Is_Return_Object; - - function Is_Safe_To_Reevaluate (Id : E) return B is - begin - return Flag249 (Id); - end Is_Safe_To_Reevaluate; - - function Is_Shared_Passive (Id : E) return B is - begin - return Flag60 (Id); - end Is_Shared_Passive; - - function Is_Static_Type (Id : E) return B is - begin - return Flag281 (Id); - end Is_Static_Type; - - function Is_Statically_Allocated (Id : E) return B is - begin - return Flag28 (Id); - end Is_Statically_Allocated; - - function Is_Tag (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Flag78 (Id); - end Is_Tag; - - function Is_Tagged_Type (Id : E) return B is - begin - return Flag55 (Id); - end Is_Tagged_Type; - - function Is_Thunk (Id : E) return B is - begin - return Flag225 (Id); - end Is_Thunk; - - function Is_Trivial_Subprogram (Id : E) return B is - begin - return Flag235 (Id); - end Is_Trivial_Subprogram; - - function Is_True_Constant (Id : E) return B is - begin - return Flag163 (Id); - end Is_True_Constant; - - function Is_Unchecked_Union (Id : E) return B is - begin - return Flag117 (Implementation_Base_Type (Id)); - end Is_Unchecked_Union; - - function Is_Underlying_Full_View (Id : E) return B is - begin - return Flag298 (Id); - end Is_Underlying_Full_View; - - function Is_Underlying_Record_View (Id : E) return B is - begin - return Flag246 (Id); - end Is_Underlying_Record_View; - - function Is_Unimplemented (Id : E) return B is - begin - return Flag284 (Id); - end Is_Unimplemented; - - function Is_Unsigned_Type (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag144 (Id); - end Is_Unsigned_Type; - - function Is_Uplevel_Referenced_Entity (Id : E) return B is - begin - return Flag283 (Id); - end Is_Uplevel_Referenced_Entity; - - function Is_Valued_Procedure (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Procedure); - return Flag127 (Id); - end Is_Valued_Procedure; - - function Is_Visible_Formal (Id : E) return B is - begin - return Flag206 (Id); - end Is_Visible_Formal; - - function Is_Visible_Lib_Unit (Id : E) return B is - begin - return Flag116 (Id); - end Is_Visible_Lib_Unit; - - function Is_Volatile (Id : E) return B is - begin - pragma Assert (Nkind (Id) in N_Entity); - - if Is_Type (Id) then - return Flag16 (Base_Type (Id)); - else - return Flag16 (Id); - end if; - end Is_Volatile; - - function Is_Volatile_Full_Access (Id : E) return B is - begin - return Flag285 (Id); - end Is_Volatile_Full_Access; - - function Itype_Printed (Id : E) return B is - begin - pragma Assert (Is_Itype (Id)); - return Flag202 (Id); - end Itype_Printed; - - function Kill_Elaboration_Checks (Id : E) return B is - begin - return Flag32 (Id); - end Kill_Elaboration_Checks; - - function Kill_Range_Checks (Id : E) return B is - begin - return Flag33 (Id); - end Kill_Range_Checks; - - function Known_To_Have_Preelab_Init (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag207 (Id); - end Known_To_Have_Preelab_Init; - - function Last_Aggregate_Assignment (Id : E) return N is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - return Node30 (Id); - end Last_Aggregate_Assignment; - - function Last_Assignment (Id : E) return N is - begin - pragma Assert (Is_Assignable (Id)); - return Node26 (Id); - end Last_Assignment; - - function Last_Entity (Id : E) return E is - begin - return Node20 (Id); - end Last_Entity; - - function Limited_View (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Package); - return Node23 (Id); - end Limited_View; - - function Linker_Section_Pragma (Id : E) return N is - begin - pragma Assert - (Is_Object (Id) or else Is_Subprogram (Id) or else Is_Type (Id)); - return Node33 (Id); - end Linker_Section_Pragma; - - function Lit_Hash (Id : E) return E is - begin - pragma Assert (Is_Enumeration_Type (Id)); - return Node21 (Id); - end Lit_Hash; - - function Lit_Indexes (Id : E) return E is - begin - pragma Assert (Is_Enumeration_Type (Id)); - return Node18 (Id); - end Lit_Indexes; - - function Lit_Strings (Id : E) return E is - begin - pragma Assert (Is_Enumeration_Type (Id)); - return Node16 (Id); - end Lit_Strings; - - function Low_Bound_Tested (Id : E) return B is - begin - return Flag205 (Id); - end Low_Bound_Tested; - - function Machine_Radix_10 (Id : E) return B is - begin - pragma Assert (Is_Decimal_Fixed_Point_Type (Id)); - return Flag84 (Id); - end Machine_Radix_10; - - function Master_Id (Id : E) return E is - begin - pragma Assert (Is_Access_Type (Id)); - return Node17 (Id); - end Master_Id; - - function Materialize_Entity (Id : E) return B is - begin - return Flag168 (Id); - end Materialize_Entity; - - function May_Inherit_Delayed_Rep_Aspects (Id : E) return B is - begin - return Flag262 (Id); - end May_Inherit_Delayed_Rep_Aspects; - - function Mechanism (Id : E) return M is - begin - pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id)); - return UI_To_Int (Uint8 (Id)); - end Mechanism; - - function Minimum_Accessibility (Id : E) return E is - begin - pragma Assert (Is_Formal (Id)); - return Node24 (Id); - end Minimum_Accessibility; - - function Modulus (Id : E) return Uint is - begin - pragma Assert (Is_Modular_Integer_Type (Id)); - return Uint17 (Base_Type (Id)); - end Modulus; - - function Must_Be_On_Byte_Boundary (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag183 (Id); - end Must_Be_On_Byte_Boundary; - - function Must_Have_Preelab_Init (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag208 (Id); - end Must_Have_Preelab_Init; - - function Needs_Activation_Record (Id : E) return B is - begin - return Flag306 (Id); - end Needs_Activation_Record; - - function Needs_Debug_Info (Id : E) return B is - begin - return Flag147 (Id); - end Needs_Debug_Info; - - function Needs_No_Actuals (Id : E) return B is - begin - pragma Assert - (Is_Overloadable (Id) - or else Ekind (Id) in E_Subprogram_Type | E_Entry_Family); - return Flag22 (Id); - end Needs_No_Actuals; - - function Never_Set_In_Source (Id : E) return B is - begin - return Flag115 (Id); - end Never_Set_In_Source; - - function Next_Inlined_Subprogram (Id : E) return E is - begin - return Node12 (Id); - end Next_Inlined_Subprogram; - - function No_Dynamic_Predicate_On_Actual (Id : E) return Boolean is - begin - pragma Assert (Is_Discrete_Type (Id)); - return Flag276 (Id); - end No_Dynamic_Predicate_On_Actual; - - function No_Pool_Assigned (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag131 (Root_Type (Id)); - end No_Pool_Assigned; - - function No_Predicate_On_Actual (Id : E) return Boolean is - begin - pragma Assert (Is_Discrete_Type (Id)); - return Flag275 (Id); - end No_Predicate_On_Actual; - - function No_Reordering (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id)); - return Flag239 (Implementation_Base_Type (Id)); - end No_Reordering; - - function No_Return (Id : E) return B is - begin - return Flag113 (Id); - end No_Return; - - function No_Strict_Aliasing (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag136 (Base_Type (Id)); - end No_Strict_Aliasing; - - function No_Tagged_Streams_Pragma (Id : E) return N is - begin - pragma Assert (Is_Tagged_Type (Id)); - return Node32 (Id); - end No_Tagged_Streams_Pragma; - - function Non_Binary_Modulus (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag58 (Base_Type (Id)); - end Non_Binary_Modulus; - - function Non_Limited_View (Id : E) return E is - begin - pragma Assert - (Ekind (Id) in Incomplete_Kind - or else - Ekind (Id) in Class_Wide_Kind - or else - Ekind (Id) = E_Abstract_State); - return Node19 (Id); - end Non_Limited_View; - - function Nonzero_Is_True (Id : E) return B is - begin - pragma Assert (Root_Type (Id) = Standard_Boolean); - return Flag162 (Base_Type (Id)); - end Nonzero_Is_True; - - function Normalized_First_Bit (Id : E) return U is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - return Uint8 (Id); - end Normalized_First_Bit; - - function Normalized_Position (Id : E) return U is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - return Uint14 (Id); - end Normalized_Position; - - function Normalized_Position_Max (Id : E) return U is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - return Uint10 (Id); - end Normalized_Position_Max; - - function OK_To_Rename (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Variable); - return Flag247 (Id); - end OK_To_Rename; - - function Optimize_Alignment_Space (Id : E) return B is - begin - pragma Assert - (Is_Type (Id) or else Ekind (Id) in E_Constant | E_Variable); - return Flag241 (Id); - end Optimize_Alignment_Space; - - function Optimize_Alignment_Time (Id : E) return B is - begin - pragma Assert - (Is_Type (Id) or else Ekind (Id) in E_Constant | E_Variable); - return Flag242 (Id); - end Optimize_Alignment_Time; - - function Original_Access_Type (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Access_Subprogram_Type); - return Node28 (Id); - end Original_Access_Type; - - function Original_Array_Type (Id : E) return E is - begin - pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id)); - return Node21 (Id); - end Original_Array_Type; - - function Original_Protected_Subprogram (Id : E) return N is - begin - return Node41 (Id); - end Original_Protected_Subprogram; - - function Original_Record_Component (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Void | E_Component | E_Discriminant); - return Node22 (Id); - end Original_Record_Component; - - function Overlays_Constant (Id : E) return B is - begin - return Flag243 (Id); - end Overlays_Constant; - - function Overridden_Operation (Id : E) return E is - begin - pragma Assert (Is_Subprogram_Or_Generic_Subprogram (Id)); - return Node26 (Id); - end Overridden_Operation; - - function Package_Instantiation (Id : E) return N is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id)); - return Node26 (Id); - end Package_Instantiation; - - function Packed_Array_Impl_Type (Id : E) return E is - begin - pragma Assert (Is_Array_Type (Id)); - return Node23 (Id); - end Packed_Array_Impl_Type; - - function Parent_Subtype (Id : E) return E is - begin - pragma Assert (Is_Record_Type (Id)); - return Node19 (Base_Type (Id)); - end Parent_Subtype; - - function Part_Of_Constituents (Id : E) return L is - begin - pragma Assert (Ekind (Id) in E_Abstract_State | E_Variable); - return Elist10 (Id); - end Part_Of_Constituents; - - function Part_Of_References (Id : E) return L is - begin - pragma Assert (Ekind (Id) = E_Variable); - return Elist11 (Id); - end Part_Of_References; - - function Partial_View_Has_Unknown_Discr (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag280 (Id); - end Partial_View_Has_Unknown_Discr; - - function Pending_Access_Types (Id : E) return L is - begin - pragma Assert (Is_Type (Id)); - return Elist15 (Id); - end Pending_Access_Types; - - function Postconditions_Proc (Id : E) return E is - begin - pragma Assert - (Ekind (Id) in E_Entry | E_Entry_Family | E_Function | E_Procedure); - return Node14 (Id); - end Postconditions_Proc; - - function Predicated_Parent (Id : E) return E is - begin - pragma Assert - (Ekind (Id) in E_Array_Subtype | - E_Record_Subtype | - E_Record_Subtype_With_Private); - return Node38 (Id); - end Predicated_Parent; - - function Predicates_Ignored (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag288 (Id); - end Predicates_Ignored; - - function Prev_Entity (Id : E) return E is - begin - return Node36 (Id); - end Prev_Entity; - - function Prival (Id : E) return E is - begin - pragma Assert (Is_Protected_Component (Id)); - return Node17 (Id); - end Prival; - - function Prival_Link (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - return Node20 (Id); - end Prival_Link; - - function Private_Dependents (Id : E) return L is - begin - pragma Assert (Is_Incomplete_Or_Private_Type (Id)); - return Elist18 (Id); - end Private_Dependents; - - function Protected_Body_Subprogram (Id : E) return E is - begin - pragma Assert (Is_Subprogram_Or_Entry (Id)); - return Node11 (Id); - end Protected_Body_Subprogram; - - function Protected_Formal (Id : E) return E is - begin - pragma Assert (Is_Formal (Id)); - return Node22 (Id); - end Protected_Formal; - - function Protected_Subprogram (Id : E) return N is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - return Node39 (Id); - end Protected_Subprogram; - - function Protection_Object (Id : E) return E is - begin - pragma Assert - (Ekind (Id) in E_Entry | E_Entry_Family | E_Function | E_Procedure); - return Node23 (Id); - end Protection_Object; - - function Reachable (Id : E) return B is - begin - return Flag49 (Id); - end Reachable; - - function Receiving_Entry (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Procedure); - return Node19 (Id); - end Receiving_Entry; - - function Referenced (Id : E) return B is - begin - return Flag156 (Id); - end Referenced; - - function Referenced_As_LHS (Id : E) return B is - begin - return Flag36 (Id); - end Referenced_As_LHS; - - function Referenced_As_Out_Parameter (Id : E) return B is - begin - return Flag227 (Id); - end Referenced_As_Out_Parameter; - - function Refinement_Constituents (Id : E) return L is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - return Elist8 (Id); - end Refinement_Constituents; - - function Register_Exception_Call (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Exception); - return Node20 (Id); - end Register_Exception_Call; - - function Related_Array_Object (Id : E) return E is - begin - pragma Assert (Is_Array_Type (Id)); - return Node25 (Id); - end Related_Array_Object; - - function Related_Expression (Id : E) return N is - begin - pragma Assert - (Ekind (Id) in Type_Kind | E_Constant | E_Variable | E_Function); - return Node24 (Id); - end Related_Expression; - - function Related_Instance (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Package | E_Package_Body); - return Node15 (Id); - end Related_Instance; - - function Related_Type (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Component | E_Constant | E_Variable); - return Node27 (Id); - end Related_Type; - - function Relative_Deadline_Variable (Id : E) return E is - begin - pragma Assert (Is_Task_Type (Id)); - return Node28 (Implementation_Base_Type (Id)); - end Relative_Deadline_Variable; - - function Renamed_Entity (Id : E) return N is - begin - return Node18 (Id); - end Renamed_Entity; - - function Renamed_In_Spec (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Package); - return Flag231 (Id); - end Renamed_In_Spec; - - function Renamed_Object (Id : E) return N is - begin - return Node18 (Id); - end Renamed_Object; - - function Renaming_Map (Id : E) return U is - begin - return Uint9 (Id); - end Renaming_Map; - - function Requires_Overriding (Id : E) return B is - begin - pragma Assert (Is_Overloadable (Id)); - return Flag213 (Id); - end Requires_Overriding; - - function Return_Present (Id : E) return B is - begin - return Flag54 (Id); - end Return_Present; - - function Return_Applies_To (Id : E) return N is - begin - return Node8 (Id); - end Return_Applies_To; - - function Returns_By_Ref (Id : E) return B is - begin - return Flag90 (Id); - end Returns_By_Ref; - - function Reverse_Bit_Order (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id)); - return Flag164 (Base_Type (Id)); - end Reverse_Bit_Order; - - function Reverse_Storage_Order (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id)); - return Flag93 (Base_Type (Id)); - end Reverse_Storage_Order; - - function Rewritten_For_C (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Function); - return Flag287 (Id); - end Rewritten_For_C; - - function RM_Size (Id : E) return U is - begin - pragma Assert (Is_Type (Id)); - return Uint13 (Id); - end RM_Size; - - function Scalar_Range (Id : E) return N is - begin - return Node20 (Id); - end Scalar_Range; - - function Scale_Value (Id : E) return U is - begin - return Uint16 (Id); - end Scale_Value; - - function Scope_Depth_Value (Id : E) return U is - begin - pragma Assert - (Ekind (Id) in - Concurrent_Kind | Entry_Kind | Generic_Unit_Kind | - E_Package | E_Package_Body | Subprogram_Kind | - E_Block | E_Subprogram_Body | - E_Private_Type .. E_Limited_Private_Subtype | - E_Void | E_Loop | E_Return_Statement); - return Uint22 (Id); - end Scope_Depth_Value; - - function Sec_Stack_Needed_For_Return (Id : E) return B is - begin - return Flag167 (Id); - end Sec_Stack_Needed_For_Return; - - function Shared_Var_Procs_Instance (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Variable); - return Node22 (Id); - end Shared_Var_Procs_Instance; - - function Size_Check_Code (Id : E) return N is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - return Node19 (Id); - end Size_Check_Code; - - function Size_Depends_On_Discriminant (Id : E) return B is - begin - return Flag177 (Id); - end Size_Depends_On_Discriminant; - - function Size_Known_At_Compile_Time (Id : E) return B is - begin - return Flag92 (Id); - end Size_Known_At_Compile_Time; - - function Small_Value (Id : E) return R is - begin - pragma Assert (Is_Fixed_Point_Type (Id)); - return Ureal21 (Id); - end Small_Value; - - function SPARK_Aux_Pragma (Id : E) return N is - begin - pragma Assert - (Ekind (Id) in E_Protected_Type -- concurrent types - | E_Task_Type - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body); - return Node41 (Id); - end SPARK_Aux_Pragma; - - function SPARK_Aux_Pragma_Inherited (Id : E) return B is - begin - pragma Assert - (Ekind (Id) in E_Protected_Type -- concurrent types - | E_Task_Type - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body); - return Flag266 (Id); - end SPARK_Aux_Pragma_Inherited; - - function SPARK_Pragma (Id : E) return N is - begin - pragma Assert - (Ekind (Id) in E_Constant -- objects - | E_Variable - or else - Ekind (Id) in E_Abstract_State -- overloadable - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body - or else - Ekind (Id) = E_Void -- special purpose - or else - Ekind (Id) in E_Protected_Body -- types - | E_Task_Body - or else - Is_Type (Id)); - return Node40 (Id); - end SPARK_Pragma; - - function SPARK_Pragma_Inherited (Id : E) return B is - begin - pragma Assert - (Ekind (Id) in E_Constant -- objects - | E_Variable - or else - Ekind (Id) in E_Abstract_State -- overloadable - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body - or else - Ekind (Id) = E_Void -- special purpose - or else - Ekind (Id) in E_Protected_Body -- types - | E_Task_Body - or else - Is_Type (Id)); - return Flag265 (Id); - end SPARK_Pragma_Inherited; - - function Spec_Entity (Id : E) return E is - begin - pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id)); - return Node19 (Id); - end Spec_Entity; - - function SSO_Set_High_By_Default (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id)); - return Flag273 (Base_Type (Id)); - end SSO_Set_High_By_Default; - - function SSO_Set_Low_By_Default (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id)); - return Flag272 (Base_Type (Id)); - end SSO_Set_Low_By_Default; - - function Static_Discrete_Predicate (Id : E) return S is - begin - pragma Assert (Is_Discrete_Type (Id)); - return List25 (Id); - end Static_Discrete_Predicate; - - function Static_Real_Or_String_Predicate (Id : E) return N is - begin - pragma Assert (Is_Real_Type (Id) or else Is_String_Type (Id)); - return Node25 (Id); - end Static_Real_Or_String_Predicate; - - function Status_Flag_Or_Transient_Decl (Id : E) return N is - begin - pragma Assert - (Ekind (Id) in E_Constant | E_Loop_Parameter | E_Variable); - return Node15 (Id); - end Status_Flag_Or_Transient_Decl; - - function Storage_Size_Variable (Id : E) return E is - begin - pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id)); - return Node26 (Implementation_Base_Type (Id)); - end Storage_Size_Variable; - - function Static_Elaboration_Desired (Id : E) return B is - begin - pragma Assert (Ekind (Id) = E_Package); - return Flag77 (Id); - end Static_Elaboration_Desired; - - function Static_Initialization (Id : E) return N is - begin - pragma Assert - (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id)); - return Node30 (Id); - end Static_Initialization; - - function Stored_Constraint (Id : E) return L is - begin - pragma Assert - (Is_Composite_Type (Id) and then not Is_Array_Type (Id)); - return Elist23 (Id); - end Stored_Constraint; - - function Stores_Attribute_Old_Prefix (Id : E) return B is - begin - return Flag270 (Id); - end Stores_Attribute_Old_Prefix; - - function Strict_Alignment (Id : E) return B is - begin - return Flag145 (Implementation_Base_Type (Id)); - end Strict_Alignment; - - function String_Literal_Length (Id : E) return U is - begin - return Uint16 (Id); - end String_Literal_Length; - - function String_Literal_Low_Bound (Id : E) return N is - begin - return Node18 (Id); - end String_Literal_Low_Bound; - - function Subprograms_For_Type (Id : E) return L is - begin - pragma Assert (Is_Type (Id)); - return Elist29 (Id); - end Subprograms_For_Type; - - function Subps_Index (Id : E) return U is - begin - pragma Assert (Is_Subprogram (Id)); - return Uint24 (Id); - end Subps_Index; - - function Suppress_Elaboration_Warnings (Id : E) return B is - begin - return Flag303 (Id); - end Suppress_Elaboration_Warnings; - - function Suppress_Initialization (Id : E) return B is - begin - pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable); - return Flag105 (Id); - end Suppress_Initialization; - - function Suppress_Style_Checks (Id : E) return B is - begin - return Flag165 (Id); - end Suppress_Style_Checks; - - function Suppress_Value_Tracking_On_Call (Id : E) return B is - begin - return Flag217 (Id); - end Suppress_Value_Tracking_On_Call; - - function Task_Body_Procedure (Id : E) return N is - begin - pragma Assert (Ekind (Id) in Task_Kind); - return Node25 (Id); - end Task_Body_Procedure; - - function Thunk_Entity (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure - and then Is_Thunk (Id)); - return Node31 (Id); - end Thunk_Entity; - - function Treat_As_Volatile (Id : E) return B is - begin - return Flag41 (Id); - end Treat_As_Volatile; - - function Underlying_Full_View (Id : E) return E is - begin - pragma Assert (Ekind (Id) in Private_Kind); - return Node19 (Id); - end Underlying_Full_View; - - function Underlying_Record_View (Id : E) return E is - begin - return Node28 (Id); - end Underlying_Record_View; - - function Universal_Aliasing (Id : E) return B is - begin - pragma Assert (Is_Type (Id)); - return Flag216 (Implementation_Base_Type (Id)); - end Universal_Aliasing; - - function Unset_Reference (Id : E) return N is - begin - return Node16 (Id); - end Unset_Reference; - - function Used_As_Generic_Actual (Id : E) return B is - begin - return Flag222 (Id); - end Used_As_Generic_Actual; - - function Uses_Lock_Free (Id : E) return B is - begin - pragma Assert (Is_Protected_Type (Id)); - return Flag188 (Id); - end Uses_Lock_Free; - - function Uses_Sec_Stack (Id : E) return B is - begin - return Flag95 (Id); - end Uses_Sec_Stack; - - function Validated_Object (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Variable); - return Node38 (Id); - end Validated_Object; - - function Warnings_Off (Id : E) return B is - begin - return Flag96 (Id); - end Warnings_Off; - - function Warnings_Off_Used (Id : E) return B is - begin - return Flag236 (Id); - end Warnings_Off_Used; - - function Warnings_Off_Used_Unmodified (Id : E) return B is - begin - return Flag237 (Id); - end Warnings_Off_Used_Unmodified; - - function Warnings_Off_Used_Unreferenced (Id : E) return B is - begin - return Flag238 (Id); - end Warnings_Off_Used_Unreferenced; - - function Was_Hidden (Id : E) return B is - begin - return Flag196 (Id); - end Was_Hidden; - - function Wrapped_Entity (Id : E) return E is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure - and then Is_Primitive_Wrapper (Id)); - return Node27 (Id); - end Wrapped_Entity; - - ------------------------------ - -- Classification Functions -- - ------------------------------ - - function Is_Access_Object_Type (Id : E) return B is - begin - return Is_Access_Type (Id) and then not Is_Access_Subprogram_Type (Id); - end Is_Access_Object_Type; - - function Is_Access_Type (Id : E) return B is - begin - return Ekind (Id) in Access_Kind; - end Is_Access_Type; - - function Is_Access_Protected_Subprogram_Type (Id : E) return B is - begin - return Ekind (Id) in Access_Protected_Kind; - end Is_Access_Protected_Subprogram_Type; - - function Is_Access_Subprogram_Type (Id : E) return B is - begin - return Ekind (Id) in Access_Subprogram_Kind; - end Is_Access_Subprogram_Type; - - function Is_Aggregate_Type (Id : E) return B is - begin - return Ekind (Id) in Aggregate_Kind; - end Is_Aggregate_Type; - - function Is_Anonymous_Access_Type (Id : E) return B is - begin - return Ekind (Id) in Anonymous_Access_Kind; - end Is_Anonymous_Access_Type; - - function Is_Array_Type (Id : E) return B is - begin - return Ekind (Id) in Array_Kind; - end Is_Array_Type; - - function Is_Assignable (Id : E) return B is - begin - return Ekind (Id) in Assignable_Kind; - end Is_Assignable; - - function Is_Class_Wide_Type (Id : E) return B is - begin - return Ekind (Id) in Class_Wide_Kind; - end Is_Class_Wide_Type; - - function Is_Composite_Type (Id : E) return B is - begin - return Ekind (Id) in Composite_Kind; - end Is_Composite_Type; - - function Is_Concurrent_Body (Id : E) return B is - begin - return Ekind (Id) in Concurrent_Body_Kind; - end Is_Concurrent_Body; - - function Is_Concurrent_Record_Type (Id : E) return B is - begin - return Flag20 (Id); - end Is_Concurrent_Record_Type; - - function Is_Concurrent_Type (Id : E) return B is - begin - return Ekind (Id) in Concurrent_Kind; - end Is_Concurrent_Type; - - function Is_Decimal_Fixed_Point_Type (Id : E) return B is - begin - return Ekind (Id) in Decimal_Fixed_Point_Kind; - end Is_Decimal_Fixed_Point_Type; - - function Is_Digits_Type (Id : E) return B is - begin - return Ekind (Id) in Digits_Kind; - end Is_Digits_Type; - - function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is - begin - return Ekind (Id) in Discrete_Or_Fixed_Point_Kind; - end Is_Discrete_Or_Fixed_Point_Type; - - function Is_Discrete_Type (Id : E) return B is - begin - return Ekind (Id) in Discrete_Kind; - end Is_Discrete_Type; - - function Is_Elementary_Type (Id : E) return B is - begin - return Ekind (Id) in Elementary_Kind; - end Is_Elementary_Type; - - function Is_Entry (Id : E) return B is - begin - return Ekind (Id) in Entry_Kind; - end Is_Entry; - - function Is_Enumeration_Type (Id : E) return B is - begin - return Ekind (Id) in Enumeration_Kind; - end Is_Enumeration_Type; - - function Is_Fixed_Point_Type (Id : E) return B is - begin - return Ekind (Id) in Fixed_Point_Kind; - end Is_Fixed_Point_Type; - - function Is_Floating_Point_Type (Id : E) return B is - begin - return Ekind (Id) in Float_Kind; - end Is_Floating_Point_Type; - - function Is_Formal (Id : E) return B is - begin - return Ekind (Id) in Formal_Kind; - end Is_Formal; - - function Is_Formal_Object (Id : E) return B is - begin - return Ekind (Id) in Formal_Object_Kind; - end Is_Formal_Object; - - function Is_Generic_Subprogram (Id : E) return B is - begin - return Ekind (Id) in Generic_Subprogram_Kind; - end Is_Generic_Subprogram; - - function Is_Generic_Unit (Id : E) return B is - begin - return Ekind (Id) in Generic_Unit_Kind; - end Is_Generic_Unit; - - function Is_Ghost_Entity (Id : Entity_Id) return Boolean is - begin - return Is_Checked_Ghost_Entity (Id) or else Is_Ignored_Ghost_Entity (Id); - end Is_Ghost_Entity; - - function Is_Incomplete_Or_Private_Type (Id : E) return B is - begin - return Ekind (Id) in Incomplete_Or_Private_Kind; - end Is_Incomplete_Or_Private_Type; - - function Is_Incomplete_Type (Id : E) return B is - begin - return Ekind (Id) in Incomplete_Kind; - end Is_Incomplete_Type; - - function Is_Integer_Type (Id : E) return B is - begin - return Ekind (Id) in Integer_Kind; - end Is_Integer_Type; - - function Is_Modular_Integer_Type (Id : E) return B is - begin - return Ekind (Id) in Modular_Integer_Kind; - end Is_Modular_Integer_Type; - - function Is_Named_Access_Type (Id : E) return B is - begin - return Ekind (Id) in E_Access_Type .. - E_Access_Protected_Subprogram_Type; - end Is_Named_Access_Type; - - function Is_Named_Number (Id : E) return B is - begin - return Ekind (Id) in Named_Kind; - end Is_Named_Number; - - function Is_Numeric_Type (Id : E) return B is - begin - return Ekind (Id) in Numeric_Kind; - end Is_Numeric_Type; - - function Is_Object (Id : E) return B is - begin - return Ekind (Id) in Object_Kind; - end Is_Object; - - function Is_Ordinary_Fixed_Point_Type (Id : E) return B is - begin - return Ekind (Id) in Ordinary_Fixed_Point_Kind; - end Is_Ordinary_Fixed_Point_Type; - - function Is_Overloadable (Id : E) return B is - begin - return Ekind (Id) in Overloadable_Kind; - end Is_Overloadable; - - function Is_Private_Type (Id : E) return B is - begin - return Ekind (Id) in Private_Kind; - end Is_Private_Type; - - function Is_Protected_Type (Id : E) return B is - begin - return Ekind (Id) in Protected_Kind; - end Is_Protected_Type; - - function Is_Real_Type (Id : E) return B is - begin - return Ekind (Id) in Real_Kind; - end Is_Real_Type; - - function Is_Record_Type (Id : E) return B is - begin - return Ekind (Id) in Record_Kind; - end Is_Record_Type; - - function Is_Scalar_Type (Id : E) return B is - begin - return Ekind (Id) in Scalar_Kind; - end Is_Scalar_Type; - - function Is_Signed_Integer_Type (Id : E) return B is - begin - return Ekind (Id) in Signed_Integer_Kind; - end Is_Signed_Integer_Type; - - function Is_Subprogram (Id : E) return B is - begin - return Ekind (Id) in Subprogram_Kind; - end Is_Subprogram; - - function Is_Subprogram_Or_Entry (Id : E) return B is - begin - return Ekind (Id) in Subprogram_Kind - or else - Ekind (Id) in Entry_Kind; - end Is_Subprogram_Or_Entry; - - function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B is - begin - return Ekind (Id) in Subprogram_Kind - or else - Ekind (Id) in Generic_Subprogram_Kind; - end Is_Subprogram_Or_Generic_Subprogram; - - function Is_Task_Type (Id : E) return B is - begin - return Ekind (Id) in Task_Kind; - end Is_Task_Type; - - function Is_Type (Id : E) return B is - begin - return Ekind (Id) in Type_Kind; - end Is_Type; - - ------------------------------ - -- Attribute Set Procedures -- - ------------------------------ - - -- Note: in many of these set procedures an "obvious" assertion is missing. - -- The reason for this is that in many cases, a field is set before the - -- Ekind field is set, so that the field is set when Ekind = E_Void. It - -- it is possible to add assertions that specifically include the E_Void - -- possibility, but in some cases, we just omit the assertions. - - procedure Set_Abstract_States (Id : E; V : L) is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id)); - Set_Elist25 (Id, V); - end Set_Abstract_States; - - procedure Set_Accept_Address (Id : E; V : L) is - begin - Set_Elist21 (Id, V); - end Set_Accept_Address; - - procedure Set_Access_Disp_Table (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) = E_Record_Type - and then Id = Implementation_Base_Type (Id)); - pragma Assert (V = No_Elist or else Is_Tagged_Type (Id)); - Set_Elist16 (Id, V); - end Set_Access_Disp_Table; - - procedure Set_Access_Disp_Table_Elab_Flag (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Record_Type - and then Id = Implementation_Base_Type (Id)); - pragma Assert (Is_Tagged_Type (Id)); - Set_Node30 (Id, V); - end Set_Access_Disp_Table_Elab_Flag; - - procedure Set_Access_Subprogram_Wrapper (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Subprogram_Type); - Set_Node41 (Id, V); - end Set_Access_Subprogram_Wrapper; - - procedure Set_Anonymous_Designated_Type (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Node35 (Id, V); - end Set_Anonymous_Designated_Type; - - procedure Set_Anonymous_Masters (Id : E; V : L) is - begin - pragma Assert - (Ekind (Id) - in E_Function | E_Package | E_Procedure | E_Subprogram_Body); - Set_Elist29 (Id, V); - end Set_Anonymous_Masters; - - procedure Set_Anonymous_Object (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Protected_Type | E_Task_Type); - Set_Node30 (Id, V); - end Set_Anonymous_Object; - - procedure Set_Associated_Entity (Id : E; V : E) is - begin - Set_Node37 (Id, V); - end Set_Associated_Entity; - - procedure Set_Associated_Formal_Package (Id : E; V : E) is - begin - Set_Node12 (Id, V); - end Set_Associated_Formal_Package; - - procedure Set_Associated_Node_For_Itype (Id : E; V : E) is - begin - Set_Node8 (Id, V); - end Set_Associated_Node_For_Itype; - - procedure Set_Associated_Storage_Pool (Id : E; V : E) is - begin - pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id)); - Set_Node22 (Id, V); - end Set_Associated_Storage_Pool; - - procedure Set_Activation_Record_Component (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) in E_Constant - | E_In_Parameter - | E_In_Out_Parameter - | E_Loop_Parameter - | E_Out_Parameter - | E_Variable); - Set_Node31 (Id, V); - end Set_Activation_Record_Component; - - procedure Set_Actual_Subtype (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) in E_Constant | E_Variable | E_Generic_In_Out_Parameter - or else Is_Formal (Id)); - Set_Node17 (Id, V); - end Set_Actual_Subtype; - - procedure Set_Address_Taken (Id : E; V : B := True) is - begin - Set_Flag104 (Id, V); - end Set_Address_Taken; - - procedure Set_Alias (Id : E; V : E) is - begin - pragma Assert - (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type); - Set_Node18 (Id, V); - end Set_Alias; - - procedure Set_Alignment (Id : E; V : U) is - begin - pragma Assert (Is_Type (Id) - or else Is_Formal (Id) - or else Ekind (Id) in E_Loop_Parameter - | E_Constant - | E_Exception - | E_Variable); - Set_Uint14 (Id, V); - end Set_Alignment; - - procedure Set_Barrier_Function (Id : E; V : N) is - begin - pragma Assert (Is_Entry (Id)); - Set_Node12 (Id, V); - end Set_Barrier_Function; - - procedure Set_Block_Node (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) = E_Block); - Set_Node11 (Id, V); - end Set_Block_Node; - - procedure Set_Body_Entity (Id : E; V : E) is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id)); - Set_Node19 (Id, V); - end Set_Body_Entity; - - procedure Set_Body_Needed_For_Inlining (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Package); - Set_Flag299 (Id, V); - end Set_Body_Needed_For_Inlining; - - procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) = E_Package - or else Is_Subprogram (Id) - or else Is_Generic_Unit (Id)); - Set_Flag40 (Id, V); - end Set_Body_Needed_For_SAL; - - procedure Set_Body_References (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - Set_Elist16 (Id, V); - end Set_Body_References; - - procedure Set_BIP_Initialization_Call (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - Set_Node29 (Id, V); - end Set_BIP_Initialization_Call; - - procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is - begin - pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); - Set_Flag125 (Id, V); - end Set_C_Pass_By_Copy; - - procedure Set_Can_Never_Be_Null (Id : E; V : B := True) is - begin - Set_Flag38 (Id, V); - end Set_Can_Never_Be_Null; - - procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is - begin - pragma Assert - (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id)); - Set_Flag229 (Id, V); - end Set_Can_Use_Internal_Rep; - - procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is - begin - Set_Flag31 (Id, V); - end Set_Checks_May_Be_Suppressed; - - procedure Set_Class_Wide_Clone (Id : E; V : E) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Node38 (Id, V); - end Set_Class_Wide_Clone; - - procedure Set_Class_Wide_Type (Id : E; V : E) is - begin - pragma Assert (Is_Type (Id)); - Set_Node9 (Id, V); - end Set_Class_Wide_Type; - - procedure Set_Cloned_Subtype (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Record_Subtype | E_Class_Wide_Subtype); - Set_Node16 (Id, V); - end Set_Cloned_Subtype; - - procedure Set_Component_Bit_Offset (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - Set_Uint11 (Id, V); - end Set_Component_Bit_Offset; - - procedure Set_Component_Clause (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - Set_Node13 (Id, V); - end Set_Component_Clause; - - procedure Set_Component_Size (Id : E; V : U) is - begin - pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id)); - Set_Uint22 (Id, V); - end Set_Component_Size; - - procedure Set_Component_Type (Id : E; V : E) is - begin - pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id)); - Set_Node20 (Id, V); - end Set_Component_Type; - - procedure Set_Contains_Ignored_Ghost_Code (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) in E_Block - | E_Function - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Package - | E_Package_Body - | E_Procedure - | E_Subprogram_Body); - Set_Flag279 (Id, V); - end Set_Contains_Ignored_Ghost_Code; - - procedure Set_Contract (Id : E; V : N) is - begin - pragma Assert - (Ekind (Id) in E_Protected_Type -- concurrent types - | E_Task_Body - | E_Task_Type - or else - Ekind (Id) in E_Constant -- objects - | E_Variable - or else - Ekind (Id) in E_Entry -- overloadable - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body - - or else - Is_Type (Id) -- types - - or else - Ekind (Id) = E_Void); -- special purpose - Set_Node34 (Id, V); - end Set_Contract; - - procedure Set_Contract_Wrapper (Id : E; V : E) is - begin - pragma Assert (Is_Entry (Id)); - Set_Node25 (Id, V); - end Set_Contract_Wrapper; - - procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) = E_Record_Type and then Is_Concurrent_Type (V)); - Set_Node18 (Id, V); - end Set_Corresponding_Concurrent_Type; - - procedure Set_Corresponding_Discriminant (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - Set_Node19 (Id, V); - end Set_Corresponding_Discriminant; - - procedure Set_Corresponding_Equality (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) = E_Function - and then not Comes_From_Source (Id) - and then Chars (Id) = Name_Op_Ne); - Set_Node30 (Id, V); - end Set_Corresponding_Equality; - - procedure Set_Corresponding_Function (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Procedure and then Rewritten_For_C (V)); - Set_Node32 (Id, V); - end Set_Corresponding_Function; - - procedure Set_Corresponding_Procedure (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Function and then Rewritten_For_C (Id)); - Set_Node32 (Id, V); - end Set_Corresponding_Procedure; - - procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Void | E_Subprogram_Body); - Set_Node18 (Id, V); - end Set_Corresponding_Protected_Entry; - - procedure Set_Corresponding_Record_Component (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - Set_Node21 (Id, V); - end Set_Corresponding_Record_Component; - - procedure Set_Corresponding_Record_Type (Id : E; V : E) is - begin - pragma Assert (Is_Concurrent_Type (Id)); - Set_Node18 (Id, V); - end Set_Corresponding_Record_Type; - - procedure Set_Corresponding_Remote_Type (Id : E; V : E) is - begin - Set_Node22 (Id, V); - end Set_Corresponding_Remote_Type; - - procedure Set_Current_Use_Clause (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id)); - Set_Node27 (Id, V); - end Set_Current_Use_Clause; - - procedure Set_Current_Value (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void); - Set_Node9 (Id, V); - end Set_Current_Value; - - procedure Set_CR_Discriminant (Id : E; V : E) is - begin - Set_Node23 (Id, V); - end Set_CR_Discriminant; - - procedure Set_Debug_Info_Off (Id : E; V : B := True) is - begin - Set_Flag166 (Id, V); - end Set_Debug_Info_Off; - - procedure Set_Debug_Renaming_Link (Id : E; V : E) is - begin - Set_Node25 (Id, V); - end Set_Debug_Renaming_Link; - - procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is - begin - pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id)); - Set_Node19 (Id, V); - end Set_Default_Aspect_Component_Value; - - procedure Set_Default_Aspect_Value (Id : E; V : E) is - begin - pragma Assert (Is_Scalar_Type (Id) and then Is_Base_Type (Id)); - Set_Node19 (Id, V); - end Set_Default_Aspect_Value; - - procedure Set_Default_Expr_Function (Id : E; V : E) is - begin - pragma Assert (Is_Formal (Id)); - Set_Node21 (Id, V); - end Set_Default_Expr_Function; - - procedure Set_Default_Expressions_Processed (Id : E; V : B := True) is - begin - Set_Flag108 (Id, V); - end Set_Default_Expressions_Processed; - - procedure Set_Default_Value (Id : E; V : N) is - begin - pragma Assert (Is_Formal (Id)); - Set_Node20 (Id, V); - end Set_Default_Value; - - procedure Set_Delay_Cleanups (Id : E; V : B := True) is - begin - pragma Assert - (Is_Subprogram (Id) - or else Is_Task_Type (Id) - or else Ekind (Id) = E_Block); - Set_Flag114 (Id, V); - end Set_Delay_Cleanups; - - procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is - begin - pragma Assert - (Is_Subprogram (Id) or else Ekind (Id) in E_Package | E_Package_Body); - - Set_Flag50 (Id, V); - end Set_Delay_Subprogram_Descriptors; - - procedure Set_Delta_Value (Id : E; V : R) is - begin - pragma Assert (Is_Fixed_Point_Type (Id)); - Set_Ureal18 (Id, V); - end Set_Delta_Value; - - procedure Set_Dependent_Instances (Id : E; V : L) is - begin - pragma Assert (Is_Generic_Instance (Id)); - Set_Elist8 (Id, V); - end Set_Dependent_Instances; - - procedure Set_Depends_On_Private (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag14 (Id, V); - end Set_Depends_On_Private; - - procedure Set_Derived_Type_Link (Id : E; V : E) is - begin - pragma Assert (Is_Type (Id) and then Is_Base_Type (Id)); - Set_Node31 (Id, V); - end Set_Derived_Type_Link; - - procedure Set_Digits_Value (Id : E; V : U) is - begin - pragma Assert - (Is_Floating_Point_Type (Id) - or else Is_Decimal_Fixed_Point_Type (Id)); - Set_Uint17 (Id, V); - end Set_Digits_Value; - - procedure Set_Directly_Designated_Type (Id : E; V : E) is - begin - Set_Node20 (Id, V); - end Set_Directly_Designated_Type; - - procedure Set_Disable_Controlled (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id) and then Is_Base_Type (Id)); - Set_Flag253 (Id, V); - end Set_Disable_Controlled; - - procedure Set_Discard_Names (Id : E; V : B := True) is - begin - Set_Flag88 (Id, V); - end Set_Discard_Names; - - procedure Set_Discriminal (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - Set_Node17 (Id, V); - end Set_Discriminal; - - procedure Set_Discriminal_Link (Id : E; V : E) is - begin - Set_Node10 (Id, V); - end Set_Discriminal_Link; - - procedure Set_Discriminant_Checking_Func (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Component); - Set_Node20 (Id, V); - end Set_Discriminant_Checking_Func; - - procedure Set_Discriminant_Constraint (Id : E; V : L) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Elist21 (Id, V); - end Set_Discriminant_Constraint; - - procedure Set_Discriminant_Default_Value (Id : E; V : N) is - begin - Set_Node20 (Id, V); - end Set_Discriminant_Default_Value; - - procedure Set_Discriminant_Number (Id : E; V : U) is - begin - Set_Uint15 (Id, V); - end Set_Discriminant_Number; - - procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) = E_Record_Type - and then Id = Implementation_Base_Type (Id)); - pragma Assert (V = No_Elist or else Is_Tagged_Type (Id)); - Set_Elist26 (Id, V); - end Set_Dispatch_Table_Wrappers; - - procedure Set_DT_Entry_Count (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) = E_Component); - Set_Uint15 (Id, V); - end Set_DT_Entry_Count; - - procedure Set_DT_Offset_To_Top_Func (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id)); - Set_Node25 (Id, V); - end Set_DT_Offset_To_Top_Func; - - procedure Set_DT_Position (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Uint15 (Id, V); - end Set_DT_Position; - - procedure Set_DTC_Entity (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Node16 (Id, V); - end Set_DTC_Entity; - - procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Package); - Set_Flag210 (Id, V); - end Set_Elaborate_Body_Desirable; - - procedure Set_Elaboration_Entity (Id : E; V : E) is - begin - pragma Assert - (Is_Subprogram (Id) - or else - Ekind (Id) in E_Entry | E_Entry_Family | E_Package - or else - Is_Generic_Unit (Id)); - Set_Node13 (Id, V); - end Set_Elaboration_Entity; - - procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is - begin - pragma Assert - (Is_Subprogram (Id) - or else - Ekind (Id) in E_Entry | E_Entry_Family | E_Package - or else - Is_Generic_Unit (Id)); - Set_Flag174 (Id, V); - end Set_Elaboration_Entity_Required; - - procedure Set_Encapsulating_State (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Abstract_State | E_Constant | E_Variable); - Set_Node32 (Id, V); - end Set_Encapsulating_State; - - procedure Set_Enclosing_Scope (Id : E; V : E) is - begin - Set_Node18 (Id, V); - end Set_Enclosing_Scope; - - procedure Set_Entry_Accepted (Id : E; V : B := True) is - begin - pragma Assert (Is_Entry (Id)); - Set_Flag152 (Id, V); - end Set_Entry_Accepted; - - procedure Set_Entry_Bodies_Array (Id : E; V : E) is - begin - Set_Node19 (Id, V); - end Set_Entry_Bodies_Array; - - procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is - begin - Set_Node23 (Id, V); - end Set_Entry_Cancel_Parameter; - - procedure Set_Entry_Component (Id : E; V : E) is - begin - Set_Node11 (Id, V); - end Set_Entry_Component; - - procedure Set_Entry_Formal (Id : E; V : E) is - begin - Set_Node16 (Id, V); - end Set_Entry_Formal; - - procedure Set_Entry_Index_Constant (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Entry_Index_Parameter); - Set_Node18 (Id, V); - end Set_Entry_Index_Constant; - - procedure Set_Entry_Max_Queue_Lengths_Array (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Protected_Type); - Set_Node35 (Id, V); - end Set_Entry_Max_Queue_Lengths_Array; - - procedure Set_Entry_Parameters_Type (Id : E; V : E) is - begin - Set_Node15 (Id, V); - end Set_Entry_Parameters_Type; - - procedure Set_Enum_Pos_To_Rep (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Type); - Set_Node23 (Id, V); - end Set_Enum_Pos_To_Rep; - - procedure Set_Enumeration_Pos (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Literal); - Set_Uint11 (Id, V); - end Set_Enumeration_Pos; - - procedure Set_Enumeration_Rep (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Literal); - Set_Uint12 (Id, V); - end Set_Enumeration_Rep; - - procedure Set_Enumeration_Rep_Expr (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) = E_Enumeration_Literal); - Set_Node22 (Id, V); - end Set_Enumeration_Rep_Expr; - - procedure Set_Equivalent_Type (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) in E_Class_Wide_Type - | E_Class_Wide_Subtype - | E_Access_Protected_Subprogram_Type - | E_Anonymous_Access_Protected_Subprogram_Type - | E_Access_Subprogram_Type - | E_Exception_Type); - Set_Node18 (Id, V); - end Set_Equivalent_Type; - - procedure Set_Esize (Id : E; V : U) is - begin - Set_Uint12 (Id, V); - end Set_Esize; - - procedure Set_Extra_Accessibility (Id : E; V : E) is - begin - pragma Assert - (Is_Formal (Id) or else Ekind (Id) in E_Variable | E_Constant); - Set_Node13 (Id, V); - end Set_Extra_Accessibility; - - procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) in E_Function | E_Operator | E_Subprogram_Type); - Set_Node19 (Id, V); - end Set_Extra_Accessibility_Of_Result; - - procedure Set_Extra_Constrained (Id : E; V : E) is - begin - pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable); - Set_Node23 (Id, V); - end Set_Extra_Constrained; - - procedure Set_Extra_Formal (Id : E; V : E) is - begin - Set_Node15 (Id, V); - end Set_Extra_Formal; - - procedure Set_Extra_Formals (Id : E; V : E) is - begin - pragma Assert - (Is_Overloadable (Id) - or else Ekind (Id) in E_Entry_Family - | E_Subprogram_Body - | E_Subprogram_Type); - Set_Node28 (Id, V); - end Set_Extra_Formals; - - procedure Set_Finalization_Master (Id : E; V : E) is - begin - pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id)); - Set_Node23 (Id, V); - end Set_Finalization_Master; - - procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id) and then Is_Base_Type (Id)); - Set_Flag158 (Id, V); - end Set_Finalize_Storage_Only; - - procedure Set_Finalizer (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Package | E_Package_Body); - Set_Node28 (Id, V); - end Set_Finalizer; - - procedure Set_First_Entity (Id : E; V : E) is - begin - Set_Node17 (Id, V); - end Set_First_Entity; - - procedure Set_First_Exit_Statement (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) = E_Loop); - Set_Node8 (Id, V); - end Set_First_Exit_Statement; - - procedure Set_First_Index (Id : E; V : N) is - begin - pragma Assert (Is_Array_Type (Id)); - Set_Node17 (Id, V); - end Set_First_Index; - - procedure Set_First_Literal (Id : E; V : E) is - begin - pragma Assert (Is_Enumeration_Type (Id)); - Set_Node17 (Id, V); - end Set_First_Literal; - - procedure Set_First_Private_Entity (Id : E; V : E) is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id) - or else Is_Concurrent_Type (Id)); - Set_Node16 (Id, V); - end Set_First_Private_Entity; - - procedure Set_First_Rep_Item (Id : E; V : N) is - begin - Set_Node6 (Id, V); - end Set_First_Rep_Item; - - procedure Set_Float_Rep (Id : E; V : F) is - pragma Assert (Ekind (Id) = E_Floating_Point_Type); - begin - Set_Uint10 (Id, UI_From_Int (F'Pos (V))); - end Set_Float_Rep; - - procedure Set_Freeze_Node (Id : E; V : N) is - begin - Set_Node7 (Id, V); - end Set_Freeze_Node; - - procedure Set_From_Limited_With (Id : E; V : B := True) is - begin - pragma Assert - (Is_Type (Id) or else Ekind (Id) in E_Abstract_State | E_Package); - Set_Flag159 (Id, V); - end Set_From_Limited_With; - - procedure Set_Full_View (Id : E; V : E) is - begin - pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant); - Set_Node11 (Id, V); - end Set_Full_View; - - procedure Set_Generic_Homonym (Id : E; V : E) is - begin - Set_Node11 (Id, V); - end Set_Generic_Homonym; - - procedure Set_Generic_Renamings (Id : E; V : L) is - begin - Set_Elist23 (Id, V); - end Set_Generic_Renamings; - - procedure Set_Handler_Records (Id : E; V : S) is - begin - Set_List10 (Id, V); - end Set_Handler_Records; - - procedure Set_Has_Aliased_Components (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag135 (Id, V); - end Set_Has_Aliased_Components; - - procedure Set_Has_Alignment_Clause (Id : E; V : B := True) is - begin - Set_Flag46 (Id, V); - end Set_Has_Alignment_Clause; - - procedure Set_Has_All_Calls_Remote (Id : E; V : B := True) is - begin - Set_Flag79 (Id, V); - end Set_Has_All_Calls_Remote; - - procedure Set_Has_Atomic_Components (Id : E; V : B := True) is - begin - pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id)); - Set_Flag86 (Id, V); - end Set_Has_Atomic_Components; - - procedure Set_Has_Biased_Representation (Id : E; V : B := True) is - begin - pragma Assert - ((V = False) or else (Is_Discrete_Type (Id) or else Is_Object (Id))); - Set_Flag139 (Id, V); - end Set_Has_Biased_Representation; - - procedure Set_Has_Completion (Id : E; V : B := True) is - begin - Set_Flag26 (Id, V); - end Set_Has_Completion; - - procedure Set_Has_Completion_In_Body (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag71 (Id, V); - end Set_Has_Completion_In_Body; - - procedure Set_Has_Complex_Representation (Id : E; V : B := True) is - begin - pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); - Set_Flag140 (Id, V); - end Set_Has_Complex_Representation; - - procedure Set_Has_Component_Size_Clause (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Array_Type); - Set_Flag68 (Id, V); - end Set_Has_Component_Size_Clause; - - procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag187 (Id, V); - end Set_Has_Constrained_Partial_View; - - procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is - begin - Set_Flag181 (Id, V); - end Set_Has_Contiguous_Rep; - - procedure Set_Has_Controlled_Component (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag43 (Id, V); - end Set_Has_Controlled_Component; - - procedure Set_Has_Controlling_Result (Id : E; V : B := True) is - begin - Set_Flag98 (Id, V); - end Set_Has_Controlling_Result; - - procedure Set_Has_Convention_Pragma (Id : E; V : B := True) is - begin - Set_Flag119 (Id, V); - end Set_Has_Convention_Pragma; - - procedure Set_Has_Default_Aspect (Id : E; V : B := True) is - begin - pragma Assert - ((Is_Scalar_Type (Id) or else Is_Array_Type (Id)) - and then Is_Base_Type (Id)); - Set_Flag39 (Id, V); - end Set_Has_Default_Aspect; - - procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag200 (Id, V); - end Set_Has_Delayed_Aspects; - - procedure Set_Has_Delayed_Freeze (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag18 (Id, V); - end Set_Has_Delayed_Freeze; - - procedure Set_Has_Delayed_Rep_Aspects (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag261 (Id, V); - end Set_Has_Delayed_Rep_Aspects; - - procedure Set_Has_Discriminants (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag5 (Id, V); - end Set_Has_Discriminants; - - procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Record_Type - and then Is_Tagged_Type (Id)); - Set_Flag220 (Id, V); - end Set_Has_Dispatch_Table; - - procedure Set_Has_Dynamic_Predicate_Aspect (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag258 (Id, V); - end Set_Has_Dynamic_Predicate_Aspect; - - procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is - begin - pragma Assert (Is_Enumeration_Type (Id)); - Set_Flag66 (Id, V); - end Set_Has_Enumeration_Rep_Clause; - - procedure Set_Has_Exit (Id : E; V : B := True) is - begin - Set_Flag47 (Id, V); - end Set_Has_Exit; - - procedure Set_Has_Expanded_Contract (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) in E_Entry | E_Entry_Family | E_Function | E_Procedure); - Set_Flag240 (Id, V); - end Set_Has_Expanded_Contract; - - procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is - begin - Set_Flag175 (Id, V); - end Set_Has_Forward_Instantiation; - - procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True) is - begin - Set_Flag173 (Id, V); - end Set_Has_Fully_Qualified_Name; - - procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True) is - begin - Set_Flag82 (Id, V); - end Set_Has_Gigi_Rep_Item; - - procedure Set_Has_Homonym (Id : E; V : B := True) is - begin - Set_Flag56 (Id, V); - end Set_Has_Homonym; - - procedure Set_Has_Implicit_Dereference (Id : E; V : B := True) is - begin - Set_Flag251 (Id, V); - end Set_Has_Implicit_Dereference; - - procedure Set_Has_Independent_Components (Id : E; V : B := True) is - begin - pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id)); - Set_Flag34 (Id, V); - end Set_Has_Independent_Components; - - procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag248 (Base_Type (Id), V); - end Set_Has_Inheritable_Invariants; - - procedure Set_Has_Inherited_DIC (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag133 (Base_Type (Id), V); - end Set_Has_Inherited_DIC; - - procedure Set_Has_Inherited_Invariants (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag291 (Base_Type (Id), V); - end Set_Has_Inherited_Invariants; - - procedure Set_Has_Initial_Value (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Variable | E_Out_Parameter); - Set_Flag219 (Id, V); - end Set_Has_Initial_Value; - - procedure Set_Has_Loop_Entry_Attributes (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Loop); - Set_Flag260 (Id, V); - end Set_Has_Loop_Entry_Attributes; - - procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is - begin - pragma Assert (Is_Decimal_Fixed_Point_Type (Id)); - Set_Flag83 (Id, V); - end Set_Has_Machine_Radix_Clause; - - procedure Set_Has_Master_Entity (Id : E; V : B := True) is - begin - Set_Flag21 (Id, V); - end Set_Has_Master_Entity; - - procedure Set_Has_Missing_Return (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Generic_Function); - Set_Flag142 (Id, V); - end Set_Has_Missing_Return; - - procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True) is - begin - Set_Flag101 (Id, V); - end Set_Has_Nested_Block_With_Handler; - - procedure Set_Has_Nested_Subprogram (Id : E; V : B := True) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Flag282 (Id, V); - end Set_Has_Nested_Subprogram; - - procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag75 (Id, V); - end Set_Has_Non_Standard_Rep; - - procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag172 (Id, V); - end Set_Has_Object_Size_Clause; - - procedure Set_Has_Out_Or_In_Out_Parameter (Id : E; V : B := True) is - begin - pragma Assert - (Is_Entry (Id) - or else Is_Subprogram_Or_Generic_Subprogram (Id)); - Set_Flag110 (Id, V); - end Set_Has_Out_Or_In_Out_Parameter; - - procedure Set_Has_Own_DIC (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag3 (Base_Type (Id), V); - end Set_Has_Own_DIC; - - procedure Set_Has_Own_Invariants (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag232 (Base_Type (Id), V); - end Set_Has_Own_Invariants; - - procedure Set_Has_Partial_Visible_Refinement (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - Set_Flag296 (Id, V); - end Set_Has_Partial_Visible_Refinement; - - procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is - begin - Set_Flag154 (Id, V); - end Set_Has_Per_Object_Constraint; - - procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is - begin - pragma Assert (Is_Access_Type (Id)); - Set_Flag27 (Base_Type (Id), V); - end Set_Has_Pragma_Controlled; - - procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True) is - begin - Set_Flag150 (Id, V); - end Set_Has_Pragma_Elaborate_Body; - - procedure Set_Has_Pragma_Inline (Id : E; V : B := True) is - begin - Set_Flag157 (Id, V); - end Set_Has_Pragma_Inline; - - procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True) is - begin - Set_Flag230 (Id, V); - end Set_Has_Pragma_Inline_Always; - - procedure Set_Has_Pragma_No_Inline (Id : E; V : B := True) is - begin - Set_Flag201 (Id, V); - end Set_Has_Pragma_No_Inline; - - procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is - begin - pragma Assert (Is_Enumeration_Type (Id)); - pragma Assert (Id = Base_Type (Id)); - Set_Flag198 (Id, V); - end Set_Has_Pragma_Ordered; - - procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is - begin - pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id)); - pragma Assert (Id = Base_Type (Id)); - Set_Flag121 (Id, V); - end Set_Has_Pragma_Pack; - - procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True) is - begin - Set_Flag221 (Id, V); - end Set_Has_Pragma_Preelab_Init; - - procedure Set_Has_Pragma_Pure (Id : E; V : B := True) is - begin - Set_Flag203 (Id, V); - end Set_Has_Pragma_Pure; - - procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is - begin - Set_Flag179 (Id, V); - end Set_Has_Pragma_Pure_Function; - - procedure Set_Has_Pragma_Thread_Local_Storage (Id : E; V : B := True) is - begin - Set_Flag169 (Id, V); - end Set_Has_Pragma_Thread_Local_Storage; - - procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True) is - begin - Set_Flag233 (Id, V); - end Set_Has_Pragma_Unmodified; - - procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True) is - begin - Set_Flag180 (Id, V); - end Set_Has_Pragma_Unreferenced; - - procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag212 (Id, V); - end Set_Has_Pragma_Unreferenced_Objects; - - procedure Set_Has_Pragma_Unused (Id : E; V : B := True) is - begin - Set_Flag294 (Id, V); - end Set_Has_Pragma_Unused; - - procedure Set_Has_Predicates (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void); - Set_Flag250 (Id, V); - end Set_Has_Predicates; - - procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag120 (Id, V); - end Set_Has_Primitive_Operations; - - procedure Set_Has_Private_Ancestor (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag151 (Id, V); - end Set_Has_Private_Ancestor; - - procedure Set_Has_Private_Declaration (Id : E; V : B := True) is - begin - Set_Flag155 (Id, V); - end Set_Has_Private_Declaration; - - procedure Set_Has_Private_Extension (Id : E; V : B := True) is - begin - pragma Assert (Is_Tagged_Type (Id)); - Set_Flag300 (Id, V); - end Set_Has_Private_Extension; - - procedure Set_Has_Protected (Id : E; V : B := True) is - begin - Set_Flag271 (Id, V); - end Set_Has_Protected; - - procedure Set_Has_Qualified_Name (Id : E; V : B := True) is - begin - Set_Flag161 (Id, V); - end Set_Has_Qualified_Name; - - procedure Set_Has_RACW (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Package); - Set_Flag214 (Id, V); - end Set_Has_RACW; - - procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag65 (Id, V); - end Set_Has_Record_Rep_Clause; - - procedure Set_Has_Recursive_Call (Id : E; V : B := True) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Flag143 (Id, V); - end Set_Has_Recursive_Call; - - procedure Set_Has_Shift_Operator (Id : E; V : B := True) is - begin - pragma Assert (Is_Integer_Type (Id) and then Is_Base_Type (Id)); - Set_Flag267 (Id, V); - end Set_Has_Shift_Operator; - - procedure Set_Has_Size_Clause (Id : E; V : B := True) is - begin - Set_Flag29 (Id, V); - end Set_Has_Size_Clause; - - procedure Set_Has_Small_Clause (Id : E; V : B := True) is - begin - pragma Assert (Is_Ordinary_Fixed_Point_Type (Id)); - Set_Flag67 (Id, V); - end Set_Has_Small_Clause; - - procedure Set_Has_Specified_Layout (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag100 (Id, V); - end Set_Has_Specified_Layout; - - procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag190 (Id, V); - end Set_Has_Specified_Stream_Input; - - procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag191 (Id, V); - end Set_Has_Specified_Stream_Output; - - procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag192 (Id, V); - end Set_Has_Specified_Stream_Read; - - procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag193 (Id, V); - end Set_Has_Specified_Stream_Write; - - procedure Set_Has_Static_Discriminants (Id : E; V : B := True) is - begin - Set_Flag211 (Id, V); - end Set_Has_Static_Discriminants; - - procedure Set_Has_Static_Predicate (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag269 (Id, V); - end Set_Has_Static_Predicate; - - procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag259 (Id, V); - end Set_Has_Static_Predicate_Aspect; - - procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is - begin - pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id)); - pragma Assert (Id = Base_Type (Id)); - Set_Flag23 (Id, V); - end Set_Has_Storage_Size_Clause; - - procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is - begin - pragma Assert (Is_Elementary_Type (Id)); - Set_Flag184 (Id, V); - end Set_Has_Stream_Size_Clause; - - procedure Set_Has_Task (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag30 (Id, V); - end Set_Has_Task; - - procedure Set_Has_Thunks (Id : E; V : B := True) is - begin - pragma Assert (Is_Tag (Id)); - Set_Flag228 (Id, V); - end Set_Has_Thunks; - - procedure Set_Has_Timing_Event (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag289 (Id, V); - end Set_Has_Timing_Event; - - procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag123 (Id, V); - end Set_Has_Unchecked_Union; - - procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag72 (Id, V); - end Set_Has_Unknown_Discriminants; - - procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - Set_Flag263 (Id, V); - end Set_Has_Visible_Refinement; - - procedure Set_Has_Volatile_Components (Id : E; V : B := True) is - begin - pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id)); - Set_Flag87 (Id, V); - end Set_Has_Volatile_Components; - - procedure Set_Has_Xref_Entry (Id : E; V : B := True) is - begin - Set_Flag182 (Id, V); - end Set_Has_Xref_Entry; - - procedure Set_Has_Yield_Aspect (Id : E; V : B := True) is - begin - pragma Assert - (Is_Entry (Id) or else Is_Subprogram_Or_Generic_Subprogram (Id)); - Set_Flag308 (Id, V); - end Set_Has_Yield_Aspect; - - procedure Set_Hiding_Loop_Variable (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Node8 (Id, V); - end Set_Hiding_Loop_Variable; - - procedure Set_Hidden_In_Formal_Instance (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) = E_Package); - Set_Elist30 (Id, V); - end Set_Hidden_In_Formal_Instance; - - procedure Set_Homonym (Id : E; V : E) is - begin - pragma Assert (Id /= V); - Set_Node4 (Id, V); - end Set_Homonym; - - procedure Set_Incomplete_Actuals (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) = E_Package); - Set_Elist24 (Id, V); - end Set_Incomplete_Actuals; - - procedure Set_Ignore_SPARK_Mode_Pragmas (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) in E_Protected_Body -- concurrent types - | E_Protected_Type - | E_Task_Body - | E_Task_Type - or else - Ekind (Id) in E_Entry -- overloadable - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body); - Set_Flag301 (Id, V); - end Set_Ignore_SPARK_Mode_Pragmas; - - procedure Set_Import_Pragma (Id : E; V : E) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Node35 (Id, V); - end Set_Import_Pragma; - - procedure Set_Interface_Alias (Id : E; V : E) is - begin - pragma Assert - (Is_Internal (Id) - and then Is_Hidden (Id) - and then (Ekind (Id) in E_Procedure | E_Function)); - Set_Node25 (Id, V); - end Set_Interface_Alias; - - procedure Set_Interfaces (Id : E; V : L) is - begin - pragma Assert (Is_Record_Type (Id)); - Set_Elist25 (Id, V); - end Set_Interfaces; - - procedure Set_In_Package_Body (Id : E; V : B := True) is - begin - Set_Flag48 (Id, V); - end Set_In_Package_Body; - - procedure Set_In_Private_Part (Id : E; V : B := True) is - begin - Set_Flag45 (Id, V); - end Set_In_Private_Part; - - procedure Set_In_Use (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag8 (Id, V); - end Set_In_Use; - - procedure Set_Initialization_Statements (Id : E; V : N) is - begin - -- Tolerate an E_Void entity since this can be called while resolving - -- an aggregate used as the initialization expression for an object - -- declaration, and this occurs before the Ekind for the object is set. - - pragma Assert (Ekind (Id) in E_Void | E_Constant | E_Variable); - Set_Node28 (Id, V); - end Set_Initialization_Statements; - - procedure Set_Inner_Instances (Id : E; V : L) is - begin - Set_Elist23 (Id, V); - end Set_Inner_Instances; - - procedure Set_Interface_Name (Id : E; V : N) is - begin - Set_Node21 (Id, V); - end Set_Interface_Name; - - procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is - begin - pragma Assert (Is_Overloadable (Id)); - Set_Flag19 (Id, V); - end Set_Is_Abstract_Subprogram; - - procedure Set_Is_Abstract_Type (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag146 (Id, V); - end Set_Is_Abstract_Type; - - procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is - begin - pragma Assert (Is_Access_Type (Id)); - Set_Flag194 (Id, V); - end Set_Is_Local_Anonymous_Access; - - procedure Set_Is_Access_Constant (Id : E; V : B := True) is - begin - pragma Assert (Is_Access_Type (Id)); - Set_Flag69 (Id, V); - end Set_Is_Access_Constant; - - procedure Set_Is_Activation_Record (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_In_Parameter); - Set_Flag305 (Id, V); - end Set_Is_Activation_Record; - - procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag293 (Id, V); - end Set_Is_Actual_Subtype; - - procedure Set_Is_Ada_2005_Only (Id : E; V : B := True) is - begin - Set_Flag185 (Id, V); - end Set_Is_Ada_2005_Only; - - procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is - begin - Set_Flag199 (Id, V); - end Set_Is_Ada_2012_Only; - - procedure Set_Is_Aliased (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag15 (Id, V); - end Set_Is_Aliased; - - procedure Set_Is_Asynchronous (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) = E_Procedure or else Is_Type (Id)); - Set_Flag81 (Id, V); - end Set_Is_Asynchronous; - - procedure Set_Is_Atomic (Id : E; V : B := True) is - begin - Set_Flag85 (Id, V); - end Set_Is_Atomic; - - procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is - begin - pragma Assert ((not V) - or else (Is_Array_Type (Id) and then Is_Base_Type (Id))); - Set_Flag122 (Id, V); - end Set_Is_Bit_Packed_Array; - - procedure Set_Is_Called (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Procedure | E_Function | E_Package); - Set_Flag102 (Id, V); - end Set_Is_Called; - - procedure Set_Is_Character_Type (Id : E; V : B := True) is - begin - Set_Flag63 (Id, V); - end Set_Is_Character_Type; - - procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True) is - begin - -- Allow this attribute to appear on unanalyzed entities - - pragma Assert (Nkind (Id) in N_Entity - or else Ekind (Id) = E_Void); - Set_Flag277 (Id, V); - end Set_Is_Checked_Ghost_Entity; - - procedure Set_Is_Child_Unit (Id : E; V : B := True) is - begin - Set_Flag73 (Id, V); - end Set_Is_Child_Unit; - - procedure Set_Is_Class_Wide_Clone (Id : E; V : B := True) is - begin - Set_Flag290 (Id, V); - end Set_Is_Class_Wide_Clone; - - procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is - begin - Set_Flag35 (Id, V); - end Set_Is_Class_Wide_Equivalent_Type; - - procedure Set_Is_Compilation_Unit (Id : E; V : B := True) is - begin - Set_Flag149 (Id, V); - end Set_Is_Compilation_Unit; - - procedure Set_Is_Completely_Hidden (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Discriminant); - Set_Flag103 (Id, V); - end Set_Is_Completely_Hidden; - - procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True) is - begin - Set_Flag20 (Id, V); - end Set_Is_Concurrent_Record_Type; - - procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True) is - begin - Set_Flag80 (Id, V); - end Set_Is_Constr_Subt_For_U_Nominal; - - procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True) is - begin - Set_Flag141 (Id, V); - end Set_Is_Constr_Subt_For_UN_Aliased; - - procedure Set_Is_Constrained (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag12 (Id, V); - end Set_Is_Constrained; - - procedure Set_Is_Constructor (Id : E; V : B := True) is - begin - Set_Flag76 (Id, V); - end Set_Is_Constructor; - - procedure Set_Is_Controlled_Active (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag42 (Id, V); - end Set_Is_Controlled_Active; - - procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is - begin - pragma Assert (Is_Formal (Id)); - Set_Flag97 (Id, V); - end Set_Is_Controlling_Formal; - - procedure Set_Is_CPP_Class (Id : E; V : B := True) is - begin - Set_Flag74 (Id, V); - end Set_Is_CPP_Class; - - procedure Set_Is_CUDA_Kernel (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag118 (Id, V); - end Set_Is_CUDA_Kernel; - - procedure Set_Is_DIC_Procedure (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Procedure); - Set_Flag132 (Id, V); - end Set_Is_DIC_Procedure; - - procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag223 (Id, V); - end Set_Is_Descendant_Of_Address; - - procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is - begin - Set_Flag176 (Id, V); - end Set_Is_Discrim_SO_Function; - - procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True) is - begin - Set_Flag264 (Id, V); - end Set_Is_Discriminant_Check_Function; - - procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True) is - begin - Set_Flag234 (Id, V); - end Set_Is_Dispatch_Table_Entity; - - procedure Set_Is_Dispatching_Operation (Id : E; V : B := True) is - begin - pragma Assert - (V = False - or else - Is_Overloadable (Id) - or else - Ekind (Id) = E_Subprogram_Type); - - Set_Flag6 (Id, V); - end Set_Is_Dispatching_Operation; - - procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is - begin - pragma Assert (Is_Elaboration_Target (Id)); - Set_Flag148 (Id, V); - end Set_Is_Elaboration_Checks_OK_Id; - - procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True) is - begin - pragma Assert (Is_Elaboration_Target (Id)); - Set_Flag304 (Id, V); - end Set_Is_Elaboration_Warnings_OK_Id; - - procedure Set_Is_Eliminated (Id : E; V : B := True) is - begin - Set_Flag124 (Id, V); - end Set_Is_Eliminated; - - procedure Set_Is_Entry_Formal (Id : E; V : B := True) is - begin - Set_Flag52 (Id, V); - end Set_Is_Entry_Formal; - - procedure Set_Is_Entry_Wrapper (Id : E; V : B := True) is - begin - Set_Flag297 (Id, V); - end Set_Is_Entry_Wrapper; - - procedure Set_Is_Exception_Handler (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Block); - Set_Flag286 (Id, V); - end Set_Is_Exception_Handler; - - procedure Set_Is_Exported (Id : E; V : B := True) is - begin - Set_Flag99 (Id, V); - end Set_Is_Exported; - - procedure Set_Is_Finalized_Transient (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Loop_Parameter | E_Variable); - Set_Flag252 (Id, V); - end Set_Is_Finalized_Transient; - - procedure Set_Is_First_Subtype (Id : E; V : B := True) is - begin - Set_Flag70 (Id, V); - end Set_Is_First_Subtype; - - procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is - begin - Set_Flag111 (Id, V); - end Set_Is_Formal_Subprogram; - - procedure Set_Is_Frozen (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag4 (Id, V); - end Set_Is_Frozen; - - procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag274 (Id, V); - end Set_Is_Generic_Actual_Subprogram; - - procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag94 (Id, V); - end Set_Is_Generic_Actual_Type; - - procedure Set_Is_Generic_Instance (Id : E; V : B := True) is - begin - Set_Flag130 (Id, V); - end Set_Is_Generic_Instance; - - procedure Set_Is_Generic_Type (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag13 (Id, V); - end Set_Is_Generic_Type; - - procedure Set_Is_Hidden (Id : E; V : B := True) is - begin - Set_Flag57 (Id, V); - end Set_Is_Hidden; - - procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag2 (Id, V); - end Set_Is_Hidden_Non_Overridden_Subpgm; - - procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is - begin - Set_Flag171 (Id, V); - end Set_Is_Hidden_Open_Scope; - - procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True) is - begin - -- Allow this attribute to appear on unanalyzed entities - - pragma Assert (Nkind (Id) in N_Entity - or else Ekind (Id) = E_Void); - Set_Flag278 (Id, V); - end Set_Is_Ignored_Ghost_Entity; - - procedure Set_Is_Ignored_Transient (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Loop_Parameter | E_Variable); - Set_Flag295 (Id, V); - end Set_Is_Ignored_Transient; - - procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag7 (Id, V); - end Set_Is_Immediately_Visible; - - procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is - begin - Set_Flag254 (Id, V); - end Set_Is_Implementation_Defined; - - procedure Set_Is_Imported (Id : E; V : B := True) is - begin - Set_Flag24 (Id, V); - end Set_Is_Imported; - - procedure Set_Is_Independent (Id : E; V : B := True) is - begin - Set_Flag268 (Id, V); - end Set_Is_Independent; - - procedure Set_Is_Initial_Condition_Procedure (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag302 (Id, V); - end Set_Is_Initial_Condition_Procedure; - - procedure Set_Is_Inlined (Id : E; V : B := True) is - begin - Set_Flag11 (Id, V); - end Set_Is_Inlined; - - procedure Set_Is_Inlined_Always (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag1 (Id, V); - end Set_Is_Inlined_Always; - - procedure Set_Is_Interface (Id : E; V : B := True) is - begin - pragma Assert (Is_Record_Type (Id)); - Set_Flag186 (Id, V); - end Set_Is_Interface; - - procedure Set_Is_Instantiated (Id : E; V : B := True) is - begin - Set_Flag126 (Id, V); - end Set_Is_Instantiated; - - procedure Set_Is_Internal (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag17 (Id, V); - end Set_Is_Internal; - - procedure Set_Is_Interrupt_Handler (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag89 (Id, V); - end Set_Is_Interrupt_Handler; - - procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True) is - begin - Set_Flag64 (Id, V); - end Set_Is_Intrinsic_Subprogram; - - procedure Set_Is_Invariant_Procedure (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Procedure); - Set_Flag257 (Id, V); - end Set_Is_Invariant_Procedure; - - procedure Set_Is_Itype (Id : E; V : B := True) is - begin - Set_Flag91 (Id, V); - end Set_Is_Itype; - - procedure Set_Is_Known_Non_Null (Id : E; V : B := True) is - begin - Set_Flag37 (Id, V); - end Set_Is_Known_Non_Null; - - procedure Set_Is_Known_Null (Id : E; V : B := True) is - begin - Set_Flag204 (Id, V); - end Set_Is_Known_Null; - - procedure Set_Is_Known_Valid (Id : E; V : B := True) is - begin - Set_Flag170 (Id, V); - end Set_Is_Known_Valid; - - procedure Set_Is_Limited_Composite (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag106 (Id, V); - end Set_Is_Limited_Composite; - - procedure Set_Is_Limited_Interface (Id : E; V : B := True) is - begin - pragma Assert (Is_Interface (Id)); - Set_Flag197 (Id, V); - end Set_Is_Limited_Interface; - - procedure Set_Is_Limited_Record (Id : E; V : B := True) is - begin - Set_Flag25 (Id, V); - end Set_Is_Limited_Record; - - procedure Set_Is_Loop_Parameter (Id : E; V : B := True) is - begin - Set_Flag307 (Id, V); - end Set_Is_Loop_Parameter; - - procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Flag137 (Id, V); - end Set_Is_Machine_Code_Subprogram; - - procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag109 (Id, V); - end Set_Is_Non_Static_Subtype; - - procedure Set_Is_Null_Init_Proc (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Procedure); - Set_Flag178 (Id, V); - end Set_Is_Null_Init_Proc; - - procedure Set_Is_Obsolescent (Id : E; V : B := True) is - begin - Set_Flag153 (Id, V); - end Set_Is_Obsolescent; - - procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Out_Parameter); - Set_Flag226 (Id, V); - end Set_Is_Only_Out_Parameter; - - procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is - begin - Set_Flag160 (Id, V); - end Set_Is_Package_Body_Entity; - - procedure Set_Is_Packed (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag51 (Id, V); - end Set_Is_Packed; - - procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True) is - begin - Set_Flag138 (Id, V); - end Set_Is_Packed_Array_Impl_Type; - - procedure Set_Is_Param_Block_Component_Type (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Void | E_General_Access_Type); - Set_Flag215 (Id, V); - end Set_Is_Param_Block_Component_Type; - - procedure Set_Is_Partial_Invariant_Procedure (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Procedure); - Set_Flag292 (Id, V); - end Set_Is_Partial_Invariant_Procedure; - - procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag9 (Id, V); - end Set_Is_Potentially_Use_Visible; - - procedure Set_Is_Predicate_Function (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Function); - Set_Flag255 (Id, V); - end Set_Is_Predicate_Function; - - procedure Set_Is_Predicate_Function_M (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag256 (Id, V); - end Set_Is_Predicate_Function_M; - - procedure Set_Is_Preelaborated (Id : E; V : B := True) is - begin - Set_Flag59 (Id, V); - end Set_Is_Preelaborated; - - procedure Set_Is_Primitive (Id : E; V : B := True) is - begin - pragma Assert (Is_Overloadable (Id) or else Is_Generic_Subprogram (Id)); - Set_Flag218 (Id, V); - end Set_Is_Primitive; - - procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag195 (Id, V); - end Set_Is_Primitive_Wrapper; - - procedure Set_Is_Private_Composite (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag107 (Id, V); - end Set_Is_Private_Composite; - - procedure Set_Is_Private_Descendant (Id : E; V : B := True) is - begin - Set_Flag53 (Id, V); - end Set_Is_Private_Descendant; - - procedure Set_Is_Private_Primitive (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Flag245 (Id, V); - end Set_Is_Private_Primitive; - - procedure Set_Is_Public (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag10 (Id, V); - end Set_Is_Public; - - procedure Set_Is_Pure (Id : E; V : B := True) is - begin - Set_Flag44 (Id, V); - end Set_Is_Pure; - - procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is - begin - pragma Assert (Is_Access_Type (Id)); - Set_Flag189 (Id, V); - end Set_Is_Pure_Unit_Access_Type; - - procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag244 (Id, V); - end Set_Is_RACW_Stub_Type; - - procedure Set_Is_Raised (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Exception); - Set_Flag224 (Id, V); - end Set_Is_Raised; - - procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is - begin - Set_Flag62 (Id, V); - end Set_Is_Remote_Call_Interface; - - procedure Set_Is_Remote_Types (Id : E; V : B := True) is - begin - Set_Flag61 (Id, V); - end Set_Is_Remote_Types; - - procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True) is - begin - Set_Flag112 (Id, V); - end Set_Is_Renaming_Of_Object; - - procedure Set_Is_Return_Object (Id : E; V : B := True) is - begin - Set_Flag209 (Id, V); - end Set_Is_Return_Object; - - procedure Set_Is_Safe_To_Reevaluate (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Flag249 (Id, V); - end Set_Is_Safe_To_Reevaluate; - - procedure Set_Is_Shared_Passive (Id : E; V : B := True) is - begin - Set_Flag60 (Id, V); - end Set_Is_Shared_Passive; - - procedure Set_Is_Static_Type (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag281 (Id, V); - end Set_Is_Static_Type; - - procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is - begin - pragma Assert - (Is_Type (Id) - or else - Ekind (Id) in E_Exception | E_Variable | E_Constant | E_Void); - Set_Flag28 (Id, V); - end Set_Is_Statically_Allocated; - - procedure Set_Is_Tag (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Constant | E_Variable); - Set_Flag78 (Id, V); - end Set_Is_Tag; - - procedure Set_Is_Tagged_Type (Id : E; V : B := True) is - begin - Set_Flag55 (Id, V); - end Set_Is_Tagged_Type; - - procedure Set_Is_Thunk (Id : E; V : B := True) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Flag225 (Id, V); - end Set_Is_Thunk; - - procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True) is - begin - Set_Flag235 (Id, V); - end Set_Is_Trivial_Subprogram; - - procedure Set_Is_True_Constant (Id : E; V : B := True) is - begin - Set_Flag163 (Id, V); - end Set_Is_True_Constant; - - procedure Set_Is_Unchecked_Union (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag117 (Id, V); - end Set_Is_Unchecked_Union; - - procedure Set_Is_Underlying_Full_View (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag298 (Id, V); - end Set_Is_Underlying_Full_View; - - procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Record_Type); - Set_Flag246 (Id, V); - end Set_Is_Underlying_Record_View; - - procedure Set_Is_Unimplemented (Id : E; V : B := True) is - begin - Set_Flag284 (Id, V); - end Set_Is_Unimplemented; - - procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is - begin - pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id)); - Set_Flag144 (Id, V); - end Set_Is_Unsigned_Type; - - procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) in E_Constant | E_Loop_Parameter | E_Variable - or else Is_Formal (Id) - or else Is_Type (Id)); - Set_Flag283 (Id, V); - end Set_Is_Uplevel_Referenced_Entity; - - procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Procedure); - Set_Flag127 (Id, V); - end Set_Is_Valued_Procedure; - - procedure Set_Is_Visible_Formal (Id : E; V : B := True) is - begin - Set_Flag206 (Id, V); - end Set_Is_Visible_Formal; - - procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is - begin - Set_Flag116 (Id, V); - end Set_Is_Visible_Lib_Unit; - - procedure Set_Is_Volatile (Id : E; V : B := True) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Flag16 (Id, V); - end Set_Is_Volatile; - - procedure Set_Is_Volatile_Full_Access (Id : E; V : B := True) is - begin - Set_Flag285 (Id, V); - end Set_Is_Volatile_Full_Access; - - procedure Set_Itype_Printed (Id : E; V : B := True) is - begin - pragma Assert (Is_Itype (Id)); - Set_Flag202 (Id, V); - end Set_Itype_Printed; - - procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is - begin - Set_Flag32 (Id, V); - end Set_Kill_Elaboration_Checks; - - procedure Set_Kill_Range_Checks (Id : E; V : B := True) is - begin - Set_Flag33 (Id, V); - end Set_Kill_Range_Checks; - - procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag207 (Id, V); - end Set_Known_To_Have_Preelab_Init; - - procedure Set_Last_Aggregate_Assignment (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - Set_Node30 (Id, V); - end Set_Last_Aggregate_Assignment; - - procedure Set_Last_Assignment (Id : E; V : N) is - begin - pragma Assert (Is_Assignable (Id)); - Set_Node26 (Id, V); - end Set_Last_Assignment; - - procedure Set_Last_Entity (Id : E; V : E) is - begin - Set_Node20 (Id, V); - end Set_Last_Entity; - - procedure Set_Limited_View (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Package - and then not Is_Generic_Instance (Id)); - Set_Node23 (Id, V); - end Set_Limited_View; - - procedure Set_Linker_Section_Pragma (Id : E; V : N) is - begin - pragma Assert - (Is_Object (Id) or else Is_Subprogram (Id) or else Is_Type (Id)); - Set_Node33 (Id, V); - end Set_Linker_Section_Pragma; - - procedure Set_Lit_Hash (Id : E; V : E) is - begin - pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id); - Set_Node21 (Id, V); - end Set_Lit_Hash; - - procedure Set_Lit_Indexes (Id : E; V : E) is - begin - pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id); - Set_Node18 (Id, V); - end Set_Lit_Indexes; - - procedure Set_Lit_Strings (Id : E; V : E) is - begin - pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id); - Set_Node16 (Id, V); - end Set_Lit_Strings; - - procedure Set_Low_Bound_Tested (Id : E; V : B := True) is - begin - pragma Assert (Is_Formal (Id)); - Set_Flag205 (Id, V); - end Set_Low_Bound_Tested; - - procedure Set_Machine_Radix_10 (Id : E; V : B := True) is - begin - pragma Assert (Is_Decimal_Fixed_Point_Type (Id)); - Set_Flag84 (Id, V); - end Set_Machine_Radix_10; - - procedure Set_Master_Id (Id : E; V : E) is - begin - pragma Assert (Is_Access_Type (Id)); - Set_Node17 (Id, V); - end Set_Master_Id; - - procedure Set_Materialize_Entity (Id : E; V : B := True) is - begin - Set_Flag168 (Id, V); - end Set_Materialize_Entity; - - procedure Set_May_Inherit_Delayed_Rep_Aspects (Id : E; V : B := True) is - begin - Set_Flag262 (Id, V); - end Set_May_Inherit_Delayed_Rep_Aspects; - - procedure Set_Mechanism (Id : E; V : M) is - begin - pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id)); - Set_Uint8 (Id, UI_From_Int (V)); - end Set_Mechanism; - - procedure Set_Minimum_Accessibility (Id : E; V : E) is - begin - pragma Assert (Is_Formal (Id)); - Set_Node24 (Id, V); - end Set_Minimum_Accessibility; - - procedure Set_Modulus (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) = E_Modular_Integer_Type); - Set_Uint17 (Id, V); - end Set_Modulus; - - procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag183 (Id, V); - end Set_Must_Be_On_Byte_Boundary; - - procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag208 (Id, V); - end Set_Must_Have_Preelab_Init; - - procedure Set_Needs_Activation_Record (Id : E; V : B := True) is - begin - Set_Flag306 (Id, V); - end Set_Needs_Activation_Record; - - procedure Set_Needs_Debug_Info (Id : E; V : B := True) is - begin - Set_Flag147 (Id, V); - end Set_Needs_Debug_Info; - - procedure Set_Needs_No_Actuals (Id : E; V : B := True) is - begin - pragma Assert - (Is_Overloadable (Id) - or else Ekind (Id) in E_Subprogram_Type | E_Entry_Family); - Set_Flag22 (Id, V); - end Set_Needs_No_Actuals; - - procedure Set_Never_Set_In_Source (Id : E; V : B := True) is - begin - Set_Flag115 (Id, V); - end Set_Never_Set_In_Source; - - procedure Set_Next_Inlined_Subprogram (Id : E; V : E) is - begin - Set_Node12 (Id, V); - end Set_Next_Inlined_Subprogram; - - procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True) is - begin - pragma Assert (Is_Discrete_Type (Id)); - Set_Flag276 (Id, V); - end Set_No_Dynamic_Predicate_On_Actual; - - procedure Set_No_Pool_Assigned (Id : E; V : B := True) is - begin - pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id)); - Set_Flag131 (Id, V); - end Set_No_Pool_Assigned; - - procedure Set_No_Predicate_On_Actual (Id : E; V : B := True) is - begin - pragma Assert (Is_Discrete_Type (Id)); - Set_Flag275 (Id, V); - end Set_No_Predicate_On_Actual; - - procedure Set_No_Reordering (Id : E; V : B := True) is - begin - pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); - Set_Flag239 (Id, V); - end Set_No_Reordering; - - procedure Set_No_Return (Id : E; V : B := True) is - begin - pragma Assert (Is_Subprogram_Or_Generic_Subprogram (Id)); - Set_Flag113 (Id, V); - end Set_No_Return; - - procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is - begin - pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id)); - Set_Flag136 (Id, V); - end Set_No_Strict_Aliasing; - - procedure Set_No_Tagged_Streams_Pragma (Id : E; V : E) is - begin - pragma Assert (Is_Tagged_Type (Id)); - Set_Node32 (Id, V); - end Set_No_Tagged_Streams_Pragma; - - procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id) and then Is_Base_Type (Id)); - Set_Flag58 (Id, V); - end Set_Non_Binary_Modulus; - - procedure Set_Non_Limited_View (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) in Incomplete_Kind - or else Ekind (Id) in E_Abstract_State | E_Class_Wide_Type); - Set_Node19 (Id, V); - end Set_Non_Limited_View; - - procedure Set_Nonzero_Is_True (Id : E; V : B := True) is - begin - pragma Assert - (Root_Type (Id) = Standard_Boolean - and then Ekind (Id) = E_Enumeration_Type); - Set_Flag162 (Id, V); - end Set_Nonzero_Is_True; - - procedure Set_Normalized_First_Bit (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - Set_Uint8 (Id, V); - end Set_Normalized_First_Bit; - - procedure Set_Normalized_Position (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - Set_Uint14 (Id, V); - end Set_Normalized_Position; - - procedure Set_Normalized_Position_Max (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Discriminant); - Set_Uint10 (Id, V); - end Set_Normalized_Position_Max; - - procedure Set_OK_To_Rename (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Flag247 (Id, V); - end Set_OK_To_Rename; - - procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is - begin - pragma Assert - (Is_Type (Id) or else Ekind (Id) in E_Constant | E_Variable); - Set_Flag241 (Id, V); - end Set_Optimize_Alignment_Space; - - procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is - begin - pragma Assert - (Is_Type (Id) or else Ekind (Id) in E_Constant | E_Variable); - Set_Flag242 (Id, V); - end Set_Optimize_Alignment_Time; - - procedure Set_Original_Access_Type (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Access_Subprogram_Type); - Set_Node28 (Id, V); - end Set_Original_Access_Type; - - procedure Set_Original_Array_Type (Id : E; V : E) is - begin - pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id)); - Set_Node21 (Id, V); - end Set_Original_Array_Type; - - procedure Set_Original_Protected_Subprogram (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Node41 (Id, V); - end Set_Original_Protected_Subprogram; - - procedure Set_Original_Record_Component (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Void | E_Component | E_Discriminant); - Set_Node22 (Id, V); - end Set_Original_Record_Component; - - procedure Set_Overlays_Constant (Id : E; V : B := True) is - begin - Set_Flag243 (Id, V); - end Set_Overlays_Constant; - - procedure Set_Overridden_Operation (Id : E; V : E) is - begin - pragma Assert (Is_Subprogram_Or_Generic_Subprogram (Id)); - Set_Node26 (Id, V); - end Set_Overridden_Operation; - - procedure Set_Package_Instantiation (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in E_Void | E_Generic_Package | E_Package); - Set_Node26 (Id, V); - end Set_Package_Instantiation; - - procedure Set_Packed_Array_Impl_Type (Id : E; V : E) is - begin - pragma Assert (Is_Array_Type (Id)); - Set_Node23 (Id, V); - end Set_Packed_Array_Impl_Type; - - procedure Set_Parent_Subtype (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Record_Type); - Set_Node19 (Id, V); - end Set_Parent_Subtype; - - procedure Set_Part_Of_Constituents (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) in E_Abstract_State | E_Variable); - Set_Elist10 (Id, V); - end Set_Part_Of_Constituents; - - procedure Set_Part_Of_References (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Elist11 (Id, V); - end Set_Part_Of_References; - - procedure Set_Partial_View_Has_Unknown_Discr (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag280 (Id, V); - end Set_Partial_View_Has_Unknown_Discr; - - procedure Set_Pending_Access_Types (Id : E; V : L) is - begin - pragma Assert (Is_Type (Id)); - Set_Elist15 (Id, V); - end Set_Pending_Access_Types; - - procedure Set_Postconditions_Proc (Id : E; V : E) is - begin - pragma Assert - (Ekind (Id) in E_Entry | E_Entry_Family | E_Function | E_Procedure); - Set_Node14 (Id, V); - end Set_Postconditions_Proc; - - procedure Set_Predicated_Parent (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Array_Subtype - | E_Record_Subtype - | E_Record_Subtype_With_Private); - Set_Node38 (Id, V); - end Set_Predicated_Parent; - - procedure Set_Predicates_Ignored (Id : E; V : B) is - begin - pragma Assert (Is_Type (Id)); - Set_Flag288 (Id, V); - end Set_Predicates_Ignored; - - procedure Set_Direct_Primitive_Operations (Id : E; V : L) is - begin - pragma Assert (Is_Tagged_Type (Id)); - Set_Elist10 (Id, V); - end Set_Direct_Primitive_Operations; - - procedure Set_Prival (Id : E; V : E) is - begin - pragma Assert (Is_Protected_Component (Id)); - Set_Node17 (Id, V); - end Set_Prival; - - procedure Set_Prival_Link (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - Set_Node20 (Id, V); - end Set_Prival_Link; - - procedure Set_Private_Dependents (Id : E; V : L) is - begin - pragma Assert (Is_Incomplete_Or_Private_Type (Id)); - Set_Elist18 (Id, V); - end Set_Private_Dependents; - - procedure Set_Prev_Entity (Id : E; V : E) is - begin - Set_Node36 (Id, V); - end Set_Prev_Entity; - - procedure Set_Protected_Body_Subprogram (Id : E; V : E) is - begin - pragma Assert (Is_Subprogram_Or_Entry (Id)); - Set_Node11 (Id, V); - end Set_Protected_Body_Subprogram; - - procedure Set_Protected_Formal (Id : E; V : E) is - begin - pragma Assert (Is_Formal (Id)); - Set_Node22 (Id, V); - end Set_Protected_Formal; - - procedure Set_Protected_Subprogram (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure); - Set_Node39 (Id, V); - end Set_Protected_Subprogram; - - procedure Set_Protection_Object (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Entry - | E_Entry_Family - | E_Function - | E_Procedure); - Set_Node23 (Id, V); - end Set_Protection_Object; - - procedure Set_Reachable (Id : E; V : B := True) is - begin - Set_Flag49 (Id, V); - end Set_Reachable; - - procedure Set_Receiving_Entry (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Procedure); - Set_Node19 (Id, V); - end Set_Receiving_Entry; - - procedure Set_Referenced (Id : E; V : B := True) is - begin - Set_Flag156 (Id, V); - end Set_Referenced; - - procedure Set_Referenced_As_LHS (Id : E; V : B := True) is - begin - Set_Flag36 (Id, V); - end Set_Referenced_As_LHS; - - procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True) is - begin - Set_Flag227 (Id, V); - end Set_Referenced_As_Out_Parameter; - - procedure Set_Refinement_Constituents (Id : E; V : L) is - begin - pragma Assert (Ekind (Id) = E_Abstract_State); - Set_Elist8 (Id, V); - end Set_Refinement_Constituents; - - procedure Set_Register_Exception_Call (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) = E_Exception); - Set_Node20 (Id, V); - end Set_Register_Exception_Call; - - procedure Set_Related_Array_Object (Id : E; V : E) is - begin - pragma Assert (Is_Array_Type (Id)); - Set_Node25 (Id, V); - end Set_Related_Array_Object; - - procedure Set_Related_Expression (Id : E; V : N) is - begin - pragma Assert - (Ekind (Id) in - Type_Kind | E_Constant | E_Variable | E_Function | E_Void); - Set_Node24 (Id, V); - end Set_Related_Expression; - - procedure Set_Related_Instance (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Package | E_Package_Body); - Set_Node15 (Id, V); - end Set_Related_Instance; - - procedure Set_Related_Type (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Component | E_Constant | E_Variable); - Set_Node27 (Id, V); - end Set_Related_Type; - - procedure Set_Relative_Deadline_Variable (Id : E; V : E) is - begin - pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id)); - Set_Node28 (Id, V); - end Set_Relative_Deadline_Variable; - - procedure Set_Renamed_Entity (Id : E; V : N) is - begin - Set_Node18 (Id, V); - end Set_Renamed_Entity; - - procedure Set_Renamed_In_Spec (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Package); - Set_Flag231 (Id, V); - end Set_Renamed_In_Spec; - - procedure Set_Renamed_Object (Id : E; V : N) is - begin - Set_Node18 (Id, V); - end Set_Renamed_Object; - - procedure Set_Renaming_Map (Id : E; V : U) is - begin - Set_Uint9 (Id, V); - end Set_Renaming_Map; - - procedure Set_Requires_Overriding (Id : E; V : B := True) is - begin - pragma Assert (Is_Overloadable (Id)); - Set_Flag213 (Id, V); - end Set_Requires_Overriding; - - procedure Set_Return_Present (Id : E; V : B := True) is - begin - Set_Flag54 (Id, V); - end Set_Return_Present; - - procedure Set_Return_Applies_To (Id : E; V : N) is - begin - Set_Node8 (Id, V); - end Set_Return_Applies_To; - - procedure Set_Returns_By_Ref (Id : E; V : B := True) is - begin - Set_Flag90 (Id, V); - end Set_Returns_By_Ref; - - procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is - begin - pragma Assert - (Is_Record_Type (Id) and then Is_Base_Type (Id)); - Set_Flag164 (Id, V); - end Set_Reverse_Bit_Order; - - procedure Set_Reverse_Storage_Order (Id : E; V : B := True) is - begin - pragma Assert - (Is_Base_Type (Id) - and then (Is_Record_Type (Id) or else Is_Array_Type (Id))); - Set_Flag93 (Id, V); - end Set_Reverse_Storage_Order; - - procedure Set_Rewritten_For_C (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Function); - Set_Flag287 (Id, V); - end Set_Rewritten_For_C; - - procedure Set_RM_Size (Id : E; V : U) is - begin - pragma Assert (Is_Type (Id)); - Set_Uint13 (Id, V); - end Set_RM_Size; - - procedure Set_Scalar_Range (Id : E; V : N) is - begin - Set_Node20 (Id, V); - end Set_Scalar_Range; - - procedure Set_Scale_Value (Id : E; V : U) is - begin - Set_Uint16 (Id, V); - end Set_Scale_Value; - - procedure Set_Scope_Depth_Value (Id : E; V : U) is - begin - pragma Assert - (Ekind (Id) in - Concurrent_Kind | Entry_Kind | Generic_Unit_Kind | - E_Package | E_Package_Body | Subprogram_Kind | - E_Block | E_Subprogram_Body | - E_Private_Type .. E_Limited_Private_Subtype | - E_Void | E_Loop | E_Return_Statement); - Set_Uint22 (Id, V); - end Set_Scope_Depth_Value; - - procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is - begin - Set_Flag167 (Id, V); - end Set_Sec_Stack_Needed_For_Return; - - procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Node22 (Id, V); - end Set_Shared_Var_Procs_Instance; - - procedure Set_Size_Check_Code (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in E_Constant | E_Variable); - Set_Node19 (Id, V); - end Set_Size_Check_Code; - - procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True) is - begin - Set_Flag177 (Id, V); - end Set_Size_Depends_On_Discriminant; - - procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True) is - begin - Set_Flag92 (Id, V); - end Set_Size_Known_At_Compile_Time; - - procedure Set_Small_Value (Id : E; V : R) is - begin - pragma Assert (Is_Fixed_Point_Type (Id)); - Set_Ureal21 (Id, V); - end Set_Small_Value; - - procedure Set_SPARK_Aux_Pragma (Id : E; V : N) is - begin - pragma Assert - (Ekind (Id) in E_Protected_Type -- concurrent types - | E_Task_Type - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body); - Set_Node41 (Id, V); - end Set_SPARK_Aux_Pragma; - - procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) in E_Protected_Type -- concurrent types - | E_Task_Type - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body); - Set_Flag266 (Id, V); - end Set_SPARK_Aux_Pragma_Inherited; - - procedure Set_SPARK_Pragma (Id : E; V : N) is - begin - pragma Assert - (Ekind (Id) in E_Constant -- objects - | E_Variable - or else - Ekind (Id) in E_Abstract_State -- overloadable - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body - or else - Ekind (Id) = E_Void -- special purpose - or else - Ekind (Id) in E_Protected_Body -- types - | E_Task_Body - or else - Is_Type (Id)); - Set_Node40 (Id, V); - end Set_SPARK_Pragma; - - procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True) is - begin - pragma Assert - (Ekind (Id) in E_Constant -- objects - | E_Variable - or else - Ekind (Id) in E_Abstract_State -- overloadable - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Operator - | E_Procedure - | E_Subprogram_Body - or else - Ekind (Id) in E_Generic_Package -- packages - | E_Package - | E_Package_Body - or else - Ekind (Id) = E_Void -- special purpose - or else - Ekind (Id) in E_Protected_Body -- types - | E_Task_Body - or else - Is_Type (Id)); - Set_Flag265 (Id, V); - end Set_SPARK_Pragma_Inherited; - - procedure Set_Spec_Entity (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id)); - Set_Node19 (Id, V); - end Set_Spec_Entity; - - procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True) is - begin - pragma Assert - (Is_Base_Type (Id) - and then (Is_Record_Type (Id) or else Is_Array_Type (Id))); - Set_Flag273 (Id, V); - end Set_SSO_Set_High_By_Default; - - procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True) is - begin - pragma Assert - (Is_Base_Type (Id) - and then (Is_Record_Type (Id) or else Is_Array_Type (Id))); - Set_Flag272 (Id, V); - end Set_SSO_Set_Low_By_Default; - - procedure Set_Static_Discrete_Predicate (Id : E; V : S) is - begin - pragma Assert (Is_Discrete_Type (Id) and then Has_Predicates (Id)); - Set_List25 (Id, V); - end Set_Static_Discrete_Predicate; - - procedure Set_Static_Real_Or_String_Predicate (Id : E; V : N) is - begin - pragma Assert ((Is_Real_Type (Id) or else Is_String_Type (Id)) - and then Has_Predicates (Id)); - Set_Node25 (Id, V); - end Set_Static_Real_Or_String_Predicate; - - procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Constant - | E_Loop_Parameter - | E_Variable); - Set_Node15 (Id, V); - end Set_Status_Flag_Or_Transient_Decl; - - procedure Set_Storage_Size_Variable (Id : E; V : E) is - begin - pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id)); - pragma Assert (Id = Base_Type (Id)); - Set_Node26 (Id, V); - end Set_Storage_Size_Variable; - - procedure Set_Static_Elaboration_Desired (Id : E; V : B) is - begin - pragma Assert (Ekind (Id) = E_Package); - Set_Flag77 (Id, V); - end Set_Static_Elaboration_Desired; - - procedure Set_Static_Initialization (Id : E; V : N) is - begin - pragma Assert - (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id)); - Set_Node30 (Id, V); - end Set_Static_Initialization; - - procedure Set_Stored_Constraint (Id : E; V : L) is - begin - pragma Assert (Nkind (Id) in N_Entity); - Set_Elist23 (Id, V); - end Set_Stored_Constraint; - - procedure Set_Stores_Attribute_Old_Prefix (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id) - or else (Ekind (Id) in E_Constant - | E_Variable)); - Set_Flag270 (Id, V); - end Set_Stores_Attribute_Old_Prefix; - - procedure Set_Strict_Alignment (Id : E; V : B := True) is - begin - pragma Assert (Id = Base_Type (Id)); - Set_Flag145 (Id, V); - end Set_Strict_Alignment; - - procedure Set_String_Literal_Length (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) = E_String_Literal_Subtype); - Set_Uint16 (Id, V); - end Set_String_Literal_Length; - - procedure Set_String_Literal_Low_Bound (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) = E_String_Literal_Subtype); - Set_Node18 (Id, V); - end Set_String_Literal_Low_Bound; - - procedure Set_Subprograms_For_Type (Id : E; V : L) is - begin - pragma Assert (Is_Type (Id)); - Set_Elist29 (Id, V); - end Set_Subprograms_For_Type; - - procedure Set_Subps_Index (Id : E; V : U) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Uint24 (Id, V); - end Set_Subps_Index; - - procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is - begin - Set_Flag303 (Id, V); - end Set_Suppress_Elaboration_Warnings; - - procedure Set_Suppress_Initialization (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable); - Set_Flag105 (Id, V); - end Set_Suppress_Initialization; - - procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is - begin - Set_Flag165 (Id, V); - end Set_Suppress_Style_Checks; - - procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True) is - begin - Set_Flag217 (Id, V); - end Set_Suppress_Value_Tracking_On_Call; - - procedure Set_Task_Body_Procedure (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) in Task_Kind); - Set_Node25 (Id, V); - end Set_Task_Body_Procedure; - - procedure Set_Thunk_Entity (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure - and then Is_Thunk (Id)); - Set_Node31 (Id, V); - end Set_Thunk_Entity; - - procedure Set_Treat_As_Volatile (Id : E; V : B := True) is - begin - Set_Flag41 (Id, V); - end Set_Treat_As_Volatile; - - procedure Set_Underlying_Full_View (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in Private_Kind); - Set_Node19 (Id, V); - end Set_Underlying_Full_View; - - procedure Set_Underlying_Record_View (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) = E_Record_Type); - Set_Node28 (Id, V); - end Set_Underlying_Record_View; - - procedure Set_Universal_Aliasing (Id : E; V : B := True) is - begin - pragma Assert (Is_Type (Id) and then Is_Base_Type (Id)); - Set_Flag216 (Id, V); - end Set_Universal_Aliasing; - - procedure Set_Unset_Reference (Id : E; V : N) is - begin - Set_Node16 (Id, V); - end Set_Unset_Reference; - - procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is - begin - Set_Flag222 (Id, V); - end Set_Used_As_Generic_Actual; - - procedure Set_Uses_Lock_Free (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Protected_Type); - Set_Flag188 (Id, V); - end Set_Uses_Lock_Free; - - procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is - begin - Set_Flag95 (Id, V); - end Set_Uses_Sec_Stack; - - procedure Set_Validated_Object (Id : E; V : N) is - begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Node38 (Id, V); - end Set_Validated_Object; - - procedure Set_Warnings_Off (Id : E; V : B := True) is - begin - Set_Flag96 (Id, V); - end Set_Warnings_Off; - - procedure Set_Warnings_Off_Used (Id : E; V : B := True) is - begin - Set_Flag236 (Id, V); - end Set_Warnings_Off_Used; - - procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True) is - begin - Set_Flag237 (Id, V); - end Set_Warnings_Off_Used_Unmodified; - - procedure Set_Warnings_Off_Used_Unreferenced (Id : E; V : B := True) is - begin - Set_Flag238 (Id, V); - end Set_Warnings_Off_Used_Unreferenced; - - procedure Set_Was_Hidden (Id : E; V : B := True) is - begin - Set_Flag196 (Id, V); - end Set_Was_Hidden; - - procedure Set_Wrapped_Entity (Id : E; V : E) is - begin - pragma Assert (Ekind (Id) in E_Function | E_Procedure - and then Is_Primitive_Wrapper (Id)); - Set_Node27 (Id, V); - end Set_Wrapped_Entity; - - ----------------------------------- - -- Field Initialization Routines -- - ----------------------------------- - - procedure Init_Alignment (Id : E) is - begin - Set_Uint14 (Id, Uint_0); - end Init_Alignment; - - procedure Init_Alignment (Id : E; V : Int) is - begin - Set_Uint14 (Id, UI_From_Int (V)); - end Init_Alignment; - - procedure Init_Component_Bit_Offset (Id : E) is - begin - Set_Uint11 (Id, No_Uint); - end Init_Component_Bit_Offset; - - procedure Init_Component_Bit_Offset (Id : E; V : Int) is - begin - Set_Uint11 (Id, UI_From_Int (V)); - end Init_Component_Bit_Offset; - - procedure Init_Component_Size (Id : E) is - begin - Set_Uint22 (Id, Uint_0); - end Init_Component_Size; - - procedure Init_Component_Size (Id : E; V : Int) is - begin - Set_Uint22 (Id, UI_From_Int (V)); - end Init_Component_Size; - - procedure Init_Digits_Value (Id : E) is - begin - Set_Uint17 (Id, Uint_0); - end Init_Digits_Value; - - procedure Init_Digits_Value (Id : E; V : Int) is - begin - Set_Uint17 (Id, UI_From_Int (V)); - end Init_Digits_Value; - - procedure Init_Esize (Id : E) is - begin - Set_Uint12 (Id, Uint_0); - end Init_Esize; - - procedure Init_Esize (Id : E; V : Int) is - begin - Set_Uint12 (Id, UI_From_Int (V)); - end Init_Esize; - - procedure Init_Normalized_First_Bit (Id : E) is - begin - Set_Uint8 (Id, No_Uint); - end Init_Normalized_First_Bit; - - procedure Init_Normalized_First_Bit (Id : E; V : Int) is - begin - Set_Uint8 (Id, UI_From_Int (V)); - end Init_Normalized_First_Bit; - - procedure Init_Normalized_Position (Id : E) is - begin - Set_Uint14 (Id, No_Uint); - end Init_Normalized_Position; - - procedure Init_Normalized_Position (Id : E; V : Int) is - begin - Set_Uint14 (Id, UI_From_Int (V)); - end Init_Normalized_Position; - - procedure Init_Normalized_Position_Max (Id : E) is - begin - Set_Uint10 (Id, No_Uint); - end Init_Normalized_Position_Max; - - procedure Init_Normalized_Position_Max (Id : E; V : Int) is - begin - Set_Uint10 (Id, UI_From_Int (V)); - end Init_Normalized_Position_Max; - - procedure Init_RM_Size (Id : E) is - begin - Set_Uint13 (Id, Uint_0); - end Init_RM_Size; - - procedure Init_RM_Size (Id : E; V : Int) is - begin - Set_Uint13 (Id, UI_From_Int (V)); - end Init_RM_Size; - - ----------------------------- - -- Init_Component_Location -- - ----------------------------- - - procedure Init_Component_Location (Id : E) is - begin - Set_Uint8 (Id, No_Uint); -- Normalized_First_Bit - Set_Uint10 (Id, No_Uint); -- Normalized_Position_Max - Set_Uint11 (Id, No_Uint); -- Component_Bit_Offset - Set_Uint12 (Id, Uint_0); -- Esize - Set_Uint14 (Id, No_Uint); -- Normalized_Position - end Init_Component_Location; - - ---------------------------- - -- Init_Object_Size_Align -- - ---------------------------- - - procedure Init_Object_Size_Align (Id : E) is - begin - Set_Uint12 (Id, Uint_0); -- Esize - Set_Uint14 (Id, Uint_0); -- Alignment - end Init_Object_Size_Align; - - --------------- - -- Init_Size -- - --------------- - - procedure Init_Size (Id : E; V : Int) is - begin - pragma Assert (not Is_Object (Id)); - Set_Uint12 (Id, UI_From_Int (V)); -- Esize - Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size - end Init_Size; - - --------------------- - -- Init_Size_Align -- - --------------------- - - procedure Init_Size_Align (Id : E) is - begin - pragma Assert (not Is_Object (Id)); - Set_Uint12 (Id, Uint_0); -- Esize - Set_Uint13 (Id, Uint_0); -- RM_Size - Set_Uint14 (Id, Uint_0); -- Alignment - end Init_Size_Align; - - ---------------------------------------------- - -- Type Representation Attribute Predicates -- - ---------------------------------------------- - - function Known_Alignment (E : Entity_Id) return B is - begin - return Uint14 (E) /= Uint_0 - and then Uint14 (E) /= No_Uint; - end Known_Alignment; - - function Known_Component_Bit_Offset (E : Entity_Id) return B is - begin - return Uint11 (E) /= No_Uint; - end Known_Component_Bit_Offset; - - function Known_Component_Size (E : Entity_Id) return B is - begin - return Uint22 (Base_Type (E)) /= Uint_0 - and then Uint22 (Base_Type (E)) /= No_Uint; - end Known_Component_Size; - - function Known_Esize (E : Entity_Id) return B is - begin - return Uint12 (E) /= Uint_0 - and then Uint12 (E) /= No_Uint; - end Known_Esize; - - function Known_Normalized_First_Bit (E : Entity_Id) return B is - begin - return Uint8 (E) /= No_Uint; - end Known_Normalized_First_Bit; - - function Known_Normalized_Position (E : Entity_Id) return B is - begin - return Uint14 (E) /= No_Uint; - end Known_Normalized_Position; - - function Known_Normalized_Position_Max (E : Entity_Id) return B is - begin - return Uint10 (E) /= No_Uint; - end Known_Normalized_Position_Max; - - function Known_RM_Size (E : Entity_Id) return B is - begin - return Uint13 (E) /= No_Uint - and then (Uint13 (E) /= Uint_0 - or else Is_Discrete_Type (E) - or else Is_Fixed_Point_Type (E)); - end Known_RM_Size; - - function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is - begin - return Uint11 (E) /= No_Uint - and then Uint11 (E) >= Uint_0; - end Known_Static_Component_Bit_Offset; - - function Known_Static_Component_Size (E : Entity_Id) return B is - begin - return Uint22 (Base_Type (E)) > Uint_0; - end Known_Static_Component_Size; - - function Known_Static_Esize (E : Entity_Id) return B is - begin - return Uint12 (E) > Uint_0 - and then not Is_Generic_Type (E); - end Known_Static_Esize; - - function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is - begin - return Uint8 (E) /= No_Uint - and then Uint8 (E) >= Uint_0; - end Known_Static_Normalized_First_Bit; - - function Known_Static_Normalized_Position (E : Entity_Id) return B is - begin - return Uint14 (E) /= No_Uint - and then Uint14 (E) >= Uint_0; - end Known_Static_Normalized_Position; - - function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is - begin - return Uint10 (E) /= No_Uint - and then Uint10 (E) >= Uint_0; - end Known_Static_Normalized_Position_Max; - - function Known_Static_RM_Size (E : Entity_Id) return B is - begin - return (Uint13 (E) > Uint_0 - or else Is_Discrete_Type (E) - or else Is_Fixed_Point_Type (E)) - and then not Is_Generic_Type (E); - end Known_Static_RM_Size; - - function Unknown_Alignment (E : Entity_Id) return B is - begin - return Uint14 (E) = Uint_0 - or else Uint14 (E) = No_Uint; - end Unknown_Alignment; - - function Unknown_Component_Bit_Offset (E : Entity_Id) return B is - begin - return Uint11 (E) = No_Uint; - end Unknown_Component_Bit_Offset; - - function Unknown_Component_Size (E : Entity_Id) return B is - begin - return Uint22 (Base_Type (E)) = Uint_0 - or else - Uint22 (Base_Type (E)) = No_Uint; - end Unknown_Component_Size; - - function Unknown_Esize (E : Entity_Id) return B is - begin - return Uint12 (E) = No_Uint - or else - Uint12 (E) = Uint_0; - end Unknown_Esize; - - function Unknown_Normalized_First_Bit (E : Entity_Id) return B is - begin - return Uint8 (E) = No_Uint; - end Unknown_Normalized_First_Bit; - - function Unknown_Normalized_Position (E : Entity_Id) return B is - begin - return Uint14 (E) = No_Uint; - end Unknown_Normalized_Position; - - function Unknown_Normalized_Position_Max (E : Entity_Id) return B is - begin - return Uint10 (E) = No_Uint; - end Unknown_Normalized_Position_Max; - - function Unknown_RM_Size (E : Entity_Id) return B is - begin - return (Uint13 (E) = Uint_0 - and then not Is_Discrete_Type (E) - and then not Is_Fixed_Point_Type (E)) - or else Uint13 (E) = No_Uint; - end Unknown_RM_Size; - - -------------------- - -- Address_Clause -- - -------------------- - - function Address_Clause (Id : E) return N is - begin - return Get_Attribute_Definition_Clause (Id, Attribute_Address); - end Address_Clause; - - --------------- - -- Aft_Value -- - --------------- - - function Aft_Value (Id : E) return U is - Result : Nat := 1; - Delta_Val : Ureal := Delta_Value (Id); - begin - while Delta_Val < Ureal_Tenth loop - Delta_Val := Delta_Val * Ureal_10; - Result := Result + 1; - end loop; - - return UI_From_Int (Result); - end Aft_Value; - - ---------------------- - -- Alignment_Clause -- - ---------------------- - - function Alignment_Clause (Id : E) return N is - begin - return Get_Attribute_Definition_Clause (Id, Attribute_Alignment); - end Alignment_Clause; - - ------------------- - -- Append_Entity -- - ------------------- - - procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id) is - Last : constant Entity_Id := Last_Entity (Scop); - - begin - Set_Scope (Id, Scop); - Set_Prev_Entity (Id, Empty); -- Empty <-- Id - - -- The entity chain is empty - - if No (Last) then - Set_First_Entity (Scop, Id); - - -- Otherwise the entity chain has at least one element - - else - Link_Entities (Last, Id); -- Last <-- Id, Last --> Id - end if; - - -- NOTE: The setting of the Next_Entity attribute of Id must happen - -- here as opposed to at the beginning of the routine because doing - -- so causes the binder to hang. It is not clear why ??? - - Set_Next_Entity (Id, Empty); -- Id --> Empty - - Set_Last_Entity (Scop, Id); - end Append_Entity; - - --------------- - -- Base_Type -- - --------------- - - function Base_Type (Id : E) return E is - begin - if Is_Base_Type (Id) then - return Id; - else - pragma Assert (Is_Type (Id)); - return Etype (Id); - end if; - end Base_Type; - - ------------------------- - -- Component_Alignment -- - ------------------------- - - -- Component Alignment is encoded using two flags, Flag128/129 as - -- follows. Note that both flags False = Align_Default, so that the - -- default initialization of flags to False initializes component - -- alignment to the default value as required. - - -- Flag128 Flag129 Value - -- ------- ------- ----- - -- False False Calign_Default - -- False True Calign_Component_Size - -- True False Calign_Component_Size_4 - -- True True Calign_Storage_Unit - - function Component_Alignment (Id : E) return C is - BT : constant Node_Id := Base_Type (Id); - - begin - pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id)); - - if Flag128 (BT) then - if Flag129 (BT) then - return Calign_Storage_Unit; - else - return Calign_Component_Size_4; - end if; - - else - if Flag129 (BT) then - return Calign_Component_Size; - else - return Calign_Default; - end if; - end if; - end Component_Alignment; - - ---------------------- - -- Declaration_Node -- - ---------------------- - - function Declaration_Node (Id : E) return N is - P : Node_Id; - - begin - if Ekind (Id) = E_Incomplete_Type - and then Present (Full_View (Id)) - then - P := Parent (Full_View (Id)); - else - P := Parent (Id); - end if; - - loop - if Nkind (P) in N_Selected_Component | N_Expanded_Name - or else (Nkind (P) = N_Defining_Program_Unit_Name - and then Is_Child_Unit (Id)) - then - P := Parent (P); - else - return P; - end if; - end loop; - end Declaration_Node; - - --------------------- - -- Designated_Type -- - --------------------- - - function Designated_Type (Id : E) return E is - Desig_Type : Entity_Id; - - begin - Desig_Type := Directly_Designated_Type (Id); - - if Is_Incomplete_Type (Desig_Type) - and then Present (Full_View (Desig_Type)) - then - return Full_View (Desig_Type); - - elsif Is_Class_Wide_Type (Desig_Type) - and then Is_Incomplete_Type (Etype (Desig_Type)) - and then Present (Full_View (Etype (Desig_Type))) - and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type)))) - then - return Class_Wide_Type (Full_View (Etype (Desig_Type))); - - else - return Desig_Type; - end if; - end Designated_Type; - - ------------------- - -- DIC_Procedure -- - ------------------- - - function DIC_Procedure (Id : E) return E is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id)); - - Subps := Subprograms_For_Type (Base_Type (Id)); - - if Present (Subps) then - Subp_Elmt := First_Elmt (Subps); - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - -- Currently the flag Is_DIC_Procedure is set for both normal DIC - -- check procedures as well as for partial DIC check procedures, - -- and we don't have a flag for the partial procedures. - - if Is_DIC_Procedure (Subp_Id) - and then not Is_Partial_DIC_Procedure (Subp_Id) - then - return Subp_Id; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end if; - - return Empty; - end DIC_Procedure; - - ---------------------- - -- Entry_Index_Type -- - ---------------------- - - function Entry_Index_Type (Id : E) return N is - begin - pragma Assert (Ekind (Id) = E_Entry_Family); - return Etype (Discrete_Subtype_Definition (Parent (Id))); - end Entry_Index_Type; - - --------------------- - -- First_Component -- - --------------------- - - function First_Component (Id : E) return E is - Comp_Id : Entity_Id; - - begin - pragma Assert - (Is_Concurrent_Type (Id) - or else Is_Incomplete_Or_Private_Type (Id) - or else Is_Record_Type (Id)); - - Comp_Id := First_Entity (Id); - while Present (Comp_Id) loop - exit when Ekind (Comp_Id) = E_Component; - Next_Entity (Comp_Id); - end loop; - - return Comp_Id; - end First_Component; - - ------------------------------------- - -- First_Component_Or_Discriminant -- - ------------------------------------- - - function First_Component_Or_Discriminant (Id : E) return E is - Comp_Id : Entity_Id; - - begin - pragma Assert - (Is_Concurrent_Type (Id) - or else Is_Incomplete_Or_Private_Type (Id) - or else Is_Record_Type (Id) - or else Has_Discriminants (Id)); - - Comp_Id := First_Entity (Id); - while Present (Comp_Id) loop - exit when Ekind (Comp_Id) in E_Component | E_Discriminant; - Next_Entity (Comp_Id); - end loop; - - return Comp_Id; - end First_Component_Or_Discriminant; - - ------------------ - -- First_Formal -- - ------------------ - - function First_Formal (Id : E) return E is - Formal : Entity_Id; - - begin - pragma Assert - (Is_Generic_Subprogram (Id) - or else Is_Overloadable (Id) - or else Ekind (Id) in E_Entry_Family - | E_Subprogram_Body - | E_Subprogram_Type); - - if Ekind (Id) = E_Enumeration_Literal then - return Empty; - - else - Formal := First_Entity (Id); - - -- Deal with the common, non-generic case first - - if No (Formal) or else Is_Formal (Formal) then - return Formal; - end if; - - -- The first/next entity chain of a generic subprogram contains all - -- generic formal parameters, followed by the formal parameters. - - if Is_Generic_Subprogram (Id) then - while Present (Formal) and then not Is_Formal (Formal) loop - Next_Entity (Formal); - end loop; - return Formal; - else - return Empty; - end if; - end if; - end First_Formal; - - ------------------------------ - -- First_Formal_With_Extras -- - ------------------------------ - - function First_Formal_With_Extras (Id : E) return E is - Formal : Entity_Id; - - begin - pragma Assert - (Is_Generic_Subprogram (Id) - or else Is_Overloadable (Id) - or else Ekind (Id) in E_Entry_Family - | E_Subprogram_Body - | E_Subprogram_Type); - - if Ekind (Id) = E_Enumeration_Literal then - return Empty; - - else - Formal := First_Entity (Id); - - -- The first/next entity chain of a generic subprogram contains all - -- generic formal parameters, followed by the formal parameters. Go - -- directly to the parameters by skipping the formal part. - - if Is_Generic_Subprogram (Id) then - while Present (Formal) and then not Is_Formal (Formal) loop - Next_Entity (Formal); - end loop; - end if; - - if Present (Formal) and then Is_Formal (Formal) then - return Formal; - else - return Extra_Formals (Id); -- Empty if no extra formals - end if; - end if; - end First_Formal_With_Extras; - - ------------------------------------- - -- Get_Attribute_Definition_Clause -- - ------------------------------------- - - function Get_Attribute_Definition_Clause - (E : Entity_Id; - Id : Attribute_Id) return Node_Id - is - N : Node_Id; - - begin - N := First_Rep_Item (E); - while Present (N) loop - if Nkind (N) = N_Attribute_Definition_Clause - and then Get_Attribute_Id (Chars (N)) = Id - then - return N; - else - Next_Rep_Item (N); - end if; - end loop; - - return Empty; - end Get_Attribute_Definition_Clause; - - --------------------------- - -- Get_Class_Wide_Pragma -- - --------------------------- - - function Get_Class_Wide_Pragma - (E : Entity_Id; - Id : Pragma_Id) return Node_Id - is - Item : Node_Id; - Items : Node_Id; - - begin - Items := Contract (E); - - if No (Items) then - return Empty; - end if; - - Item := Pre_Post_Conditions (Items); - while Present (Item) loop - if Nkind (Item) = N_Pragma - and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id - and then Class_Present (Item) - then - return Item; - end if; - - Item := Next_Pragma (Item); - end loop; - - return Empty; - end Get_Class_Wide_Pragma; - - ------------------- - -- Get_Full_View -- - ------------------- - - function Get_Full_View (T : Entity_Id) return Entity_Id is - begin - if Is_Incomplete_Type (T) and then Present (Full_View (T)) then - return Full_View (T); - - elsif Is_Class_Wide_Type (T) - and then Is_Incomplete_Type (Root_Type (T)) - and then Present (Full_View (Root_Type (T))) - then - return Class_Wide_Type (Full_View (Root_Type (T))); - - else - return T; - end if; - end Get_Full_View; - - ---------------- - -- Get_Pragma -- - ---------------- - - function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is - - -- Classification pragmas - - Is_CLS : constant Boolean := - Id = Pragma_Abstract_State or else - Id = Pragma_Attach_Handler or else - Id = Pragma_Async_Readers or else - Id = Pragma_Async_Writers or else - Id = Pragma_Constant_After_Elaboration or else - Id = Pragma_Depends or else - Id = Pragma_Effective_Reads or else - Id = Pragma_Effective_Writes or else - Id = Pragma_Extensions_Visible or else - Id = Pragma_Global or else - Id = Pragma_Initial_Condition or else - Id = Pragma_Initializes or else - Id = Pragma_Interrupt_Handler or else - Id = Pragma_No_Caching or else - Id = Pragma_Part_Of or else - Id = Pragma_Refined_Depends or else - Id = Pragma_Refined_Global or else - Id = Pragma_Refined_State or else - Id = Pragma_Volatile_Function; - - -- Contract / subprogram variant / test case pragmas - - Is_CTC : constant Boolean := - Id = Pragma_Contract_Cases or else - Id = Pragma_Subprogram_Variant or else - Id = Pragma_Test_Case; - - -- Pre / postcondition pragmas - - Is_PPC : constant Boolean := - Id = Pragma_Precondition or else - Id = Pragma_Postcondition or else - Id = Pragma_Refined_Post; - - In_Contract : constant Boolean := Is_CLS or Is_CTC or Is_PPC; - - Item : Node_Id; - Items : Node_Id; - - begin - -- Handle pragmas that appear in N_Contract nodes. Those have to be - -- extracted from their specialized list. - - if In_Contract then - Items := Contract (E); - - if No (Items) then - return Empty; - - elsif Is_CLS then - Item := Classifications (Items); - - elsif Is_CTC then - Item := Contract_Test_Cases (Items); - - else - Item := Pre_Post_Conditions (Items); - end if; - - -- Regular pragmas - - else - Item := First_Rep_Item (E); - end if; - - while Present (Item) loop - if Nkind (Item) = N_Pragma - and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id - then - return Item; - - -- All nodes in N_Contract are chained using Next_Pragma - - elsif In_Contract then - Item := Next_Pragma (Item); - - -- Regular pragmas - - else - Next_Rep_Item (Item); - end if; - end loop; - - return Empty; - end Get_Pragma; - - -------------------------------------- - -- Get_Record_Representation_Clause -- - -------------------------------------- - - function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is - N : Node_Id; - - begin - N := First_Rep_Item (E); - while Present (N) loop - if Nkind (N) = N_Record_Representation_Clause then - return N; - end if; - - Next_Rep_Item (N); - end loop; - - return Empty; - end Get_Record_Representation_Clause; - - ------------------------ - -- Has_Attach_Handler -- - ------------------------ - - function Has_Attach_Handler (Id : E) return B is - Ritem : Node_Id; - - begin - pragma Assert (Is_Protected_Type (Id)); - - Ritem := First_Rep_Item (Id); - while Present (Ritem) loop - if Nkind (Ritem) = N_Pragma - and then Pragma_Name (Ritem) = Name_Attach_Handler - then - return True; - else - Next_Rep_Item (Ritem); - end if; - end loop; - - return False; - end Has_Attach_Handler; - - ------------- - -- Has_DIC -- - ------------- - - function Has_DIC (Id : E) return B is - begin - return Has_Own_DIC (Id) or else Has_Inherited_DIC (Id); - end Has_DIC; - - ----------------- - -- Has_Entries -- - ----------------- - - function Has_Entries (Id : E) return B is - Ent : Entity_Id; - - begin - pragma Assert (Is_Concurrent_Type (Id)); - - Ent := First_Entity (Id); - while Present (Ent) loop - if Is_Entry (Ent) then - return True; - end if; - - Next_Entity (Ent); - end loop; - - return False; - end Has_Entries; - - ---------------------------- - -- Has_Foreign_Convention -- - ---------------------------- - - function Has_Foreign_Convention (Id : E) return B is - begin - -- While regular Intrinsics such as the Standard operators fit in the - -- "Ada" convention, those with an Interface_Name materialize GCC - -- builtin imports for which Ada special treatments shouldn't apply. - - return Convention (Id) in Foreign_Convention - or else (Convention (Id) = Convention_Intrinsic - and then Present (Interface_Name (Id))); - end Has_Foreign_Convention; - - --------------------------- - -- Has_Interrupt_Handler -- - --------------------------- - - function Has_Interrupt_Handler (Id : E) return B is - Ritem : Node_Id; - - begin - pragma Assert (Is_Protected_Type (Id)); - - Ritem := First_Rep_Item (Id); - while Present (Ritem) loop - if Nkind (Ritem) = N_Pragma - and then Pragma_Name (Ritem) = Name_Interrupt_Handler - then - return True; - else - Next_Rep_Item (Ritem); - end if; - end loop; - - return False; - end Has_Interrupt_Handler; - - -------------------- - -- Has_Invariants -- - -------------------- - - function Has_Invariants (Id : E) return B is - begin - return Has_Own_Invariants (Id) or else Has_Inherited_Invariants (Id); - end Has_Invariants; - - -------------------------- - -- Has_Limited_View -- - -------------------------- - - function Has_Limited_View (Id : E) return B is - begin - return Ekind (Id) = E_Package - and then not Is_Generic_Instance (Id) - and then Present (Limited_View (Id)); - end Has_Limited_View; - - -------------------------- - -- Has_Non_Limited_View -- - -------------------------- - - function Has_Non_Limited_View (Id : E) return B is - begin - return (Ekind (Id) in Incomplete_Kind - or else Ekind (Id) in Class_Wide_Kind - or else Ekind (Id) = E_Abstract_State) - and then Present (Non_Limited_View (Id)); - end Has_Non_Limited_View; - - --------------------------------- - -- Has_Non_Null_Abstract_State -- - --------------------------------- - - function Has_Non_Null_Abstract_State (Id : E) return B is - begin - pragma Assert (Is_Package_Or_Generic_Package (Id)); - - return - Present (Abstract_States (Id)) - and then - not Is_Null_State (Node (First_Elmt (Abstract_States (Id)))); - end Has_Non_Null_Abstract_State; - - ------------------------------------- - -- Has_Non_Null_Visible_Refinement -- - ------------------------------------- - - function Has_Non_Null_Visible_Refinement (Id : E) return B is - Constits : Elist_Id; - - begin - -- "Refinement" is a concept applicable only to abstract states - - pragma Assert (Ekind (Id) = E_Abstract_State); - Constits := Refinement_Constituents (Id); - - -- A partial refinement is always non-null. For a full refinement to be - -- non-null, the first constituent must be anything other than null. - - return - Has_Partial_Visible_Refinement (Id) - or else (Has_Visible_Refinement (Id) - and then Present (Constits) - and then Nkind (Node (First_Elmt (Constits))) /= N_Null); - end Has_Non_Null_Visible_Refinement; - - ----------------------------- - -- Has_Null_Abstract_State -- - ----------------------------- - - function Has_Null_Abstract_State (Id : E) return B is - pragma Assert (Is_Package_Or_Generic_Package (Id)); - - States : constant Elist_Id := Abstract_States (Id); - - begin - -- Check first available state of related package. A null abstract - -- state always appears as the sole element of the state list. - - return - Present (States) - and then Is_Null_State (Node (First_Elmt (States))); - end Has_Null_Abstract_State; - - --------------------------------- - -- Has_Null_Visible_Refinement -- - --------------------------------- - - function Has_Null_Visible_Refinement (Id : E) return B is - Constits : Elist_Id; - - begin - -- "Refinement" is a concept applicable only to abstract states - - pragma Assert (Ekind (Id) = E_Abstract_State); - Constits := Refinement_Constituents (Id); - - -- For a refinement to be null, the state's sole constituent must be a - -- null. - - return - Has_Visible_Refinement (Id) - and then Present (Constits) - and then Nkind (Node (First_Elmt (Constits))) = N_Null; - end Has_Null_Visible_Refinement; - - -------------------- - -- Has_Unmodified -- - -------------------- - - function Has_Unmodified (E : Entity_Id) return Boolean is - begin - if Has_Pragma_Unmodified (E) then - return True; - elsif Warnings_Off (E) then - Set_Warnings_Off_Used_Unmodified (E); - return True; - else - return False; - end if; - end Has_Unmodified; - - --------------------- - -- Has_Unreferenced -- - --------------------- - - function Has_Unreferenced (E : Entity_Id) return Boolean is - begin - if Has_Pragma_Unreferenced (E) then - return True; - elsif Warnings_Off (E) then - Set_Warnings_Off_Used_Unreferenced (E); - return True; - else - return False; - end if; - end Has_Unreferenced; - - ---------------------- - -- Has_Warnings_Off -- - ---------------------- - - function Has_Warnings_Off (E : Entity_Id) return Boolean is - begin - if Warnings_Off (E) then - Set_Warnings_Off_Used (E); - return True; - else - return False; - end if; - end Has_Warnings_Off; - - ------------------------------ - -- Implementation_Base_Type -- - ------------------------------ - - function Implementation_Base_Type (Id : E) return E is - Bastyp : Entity_Id; - Imptyp : Entity_Id; - - begin - Bastyp := Base_Type (Id); - - if Is_Incomplete_Or_Private_Type (Bastyp) then - Imptyp := Underlying_Type (Bastyp); - - -- If we have an implementation type, then just return it, - -- otherwise we return the Base_Type anyway. This can only - -- happen in error situations and should avoid some error bombs. - - if Present (Imptyp) then - return Base_Type (Imptyp); - else - return Bastyp; - end if; - - else - return Bastyp; - end if; - end Implementation_Base_Type; - - ------------------------- - -- Invariant_Procedure -- - ------------------------- - - function Invariant_Procedure (Id : E) return E is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id)); - - Subps := Subprograms_For_Type (Base_Type (Id)); - - if Present (Subps) then - Subp_Elmt := First_Elmt (Subps); - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Is_Invariant_Procedure (Subp_Id) then - return Subp_Id; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end if; - - return Empty; - end Invariant_Procedure; - - ------------------ - -- Is_Base_Type -- - ------------------ - - -- Global flag table allowing rapid computation of this function - - Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean := - (E_Enumeration_Subtype | - E_Incomplete_Subtype | - E_Signed_Integer_Subtype | - E_Modular_Integer_Subtype | - E_Floating_Point_Subtype | - E_Ordinary_Fixed_Point_Subtype | - E_Decimal_Fixed_Point_Subtype | - E_Array_Subtype | - E_Record_Subtype | - E_Private_Subtype | - E_Record_Subtype_With_Private | - E_Limited_Private_Subtype | - E_Access_Subtype | - E_Protected_Subtype | - E_Task_Subtype | - E_String_Literal_Subtype | - E_Class_Wide_Subtype => False, - others => True); - - function Is_Base_Type (Id : E) return Boolean is - begin - return Entity_Is_Base_Type (Ekind (Id)); - end Is_Base_Type; - - --------------------- - -- Is_Boolean_Type -- - --------------------- - - function Is_Boolean_Type (Id : E) return B is - begin - return Root_Type (Id) = Standard_Boolean; - end Is_Boolean_Type; - - ------------------------ - -- Is_Constant_Object -- - ------------------------ - - function Is_Constant_Object (Id : E) return B is - begin - return Ekind (Id) in E_Constant | E_In_Parameter | E_Loop_Parameter; - end Is_Constant_Object; - - ------------------- - -- Is_Controlled -- - ------------------- - - function Is_Controlled (Id : E) return B is - begin - return Is_Controlled_Active (Id) and then not Disable_Controlled (Id); - end Is_Controlled; - - -------------------- - -- Is_Discriminal -- - -------------------- - - function Is_Discriminal (Id : E) return B is - begin - return Ekind (Id) in E_Constant | E_In_Parameter - and then Present (Discriminal_Link (Id)); - end Is_Discriminal; - - ---------------------- - -- Is_Dynamic_Scope -- - ---------------------- - - function Is_Dynamic_Scope (Id : E) return B is - begin - return - Ekind (Id) = E_Block - or else - Ekind (Id) = E_Function - or else - Ekind (Id) = E_Procedure - or else - Ekind (Id) = E_Subprogram_Body - or else - Ekind (Id) = E_Task_Type - or else - (Ekind (Id) = E_Limited_Private_Type - and then Present (Full_View (Id)) - and then Ekind (Full_View (Id)) = E_Task_Type) - or else - Ekind (Id) = E_Entry - or else - Ekind (Id) = E_Entry_Family - or else - Ekind (Id) = E_Return_Statement; - end Is_Dynamic_Scope; - - -------------------- - -- Is_Entity_Name -- - -------------------- - - function Is_Entity_Name (N : Node_Id) return Boolean is - Kind : constant Node_Kind := Nkind (N); - - begin - -- Identifiers, operator symbols, expanded names are entity names - - return Kind in N_Identifier | N_Operator_Symbol | N_Expanded_Name - - -- Attribute references are entity names if they refer to an entity. - -- Note that we don't do this by testing for the presence of the - -- Entity field in the N_Attribute_Reference node, since it may not - -- have been set yet. - - or else (Kind = N_Attribute_Reference - and then Is_Entity_Attribute_Name (Attribute_Name (N))); - end Is_Entity_Name; - - --------------------------- - -- Is_Elaboration_Target -- - --------------------------- - - function Is_Elaboration_Target (Id : Entity_Id) return Boolean is - begin - return - Ekind (Id) in E_Constant | E_Package | E_Variable - or else Is_Generic_Unit (Id) - or else Is_Subprogram_Or_Entry (Id) - or else Is_Task_Type (Id); - end Is_Elaboration_Target; - - ----------------------- - -- Is_External_State -- - ----------------------- - - function Is_External_State (Id : E) return B is - begin - -- To qualify, the abstract state must appear with option "external" or - -- "synchronous" (SPARK RM 7.1.4(7) and (9)). - - return - Ekind (Id) = E_Abstract_State - and then (Has_Option (Id, Name_External) - or else - Has_Option (Id, Name_Synchronous)); - end Is_External_State; - - ------------------ - -- Is_Finalizer -- - ------------------ - - function Is_Finalizer (Id : E) return B is - begin - return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer; - end Is_Finalizer; - - ---------------------- - -- Is_Full_Access -- - ---------------------- - - function Is_Full_Access (Id : E) return B is - begin - return Is_Atomic (Id) or else Is_Volatile_Full_Access (Id); - end Is_Full_Access; - - ------------------- - -- Is_Null_State -- - ------------------- - - function Is_Null_State (Id : E) return B is - begin - return - Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null; - end Is_Null_State; - - ----------------------------------- - -- Is_Package_Or_Generic_Package -- - ----------------------------------- - - function Is_Package_Or_Generic_Package (Id : E) return B is - begin - return Ekind (Id) in E_Generic_Package | E_Package; - end Is_Package_Or_Generic_Package; - - --------------------- - -- Is_Packed_Array -- - --------------------- - - function Is_Packed_Array (Id : E) return B is - begin - return Is_Array_Type (Id) and then Is_Packed (Id); - end Is_Packed_Array; - - --------------- - -- Is_Prival -- - --------------- - - function Is_Prival (Id : E) return B is - begin - return Ekind (Id) in E_Constant | E_Variable - and then Present (Prival_Link (Id)); - end Is_Prival; - - ---------------------------- - -- Is_Protected_Component -- - ---------------------------- - - function Is_Protected_Component (Id : E) return B is - begin - return Ekind (Id) = E_Component and then Is_Protected_Type (Scope (Id)); - end Is_Protected_Component; - - ---------------------------- - -- Is_Protected_Interface -- - ---------------------------- - - function Is_Protected_Interface (Id : E) return B is - Typ : constant Entity_Id := Base_Type (Id); - begin - if not Is_Interface (Typ) then - return False; - elsif Is_Class_Wide_Type (Typ) then - return Is_Protected_Interface (Etype (Typ)); - else - return Protected_Present (Type_Definition (Parent (Typ))); - end if; - end Is_Protected_Interface; - - ------------------------------ - -- Is_Protected_Record_Type -- - ------------------------------ - - function Is_Protected_Record_Type (Id : E) return B is - begin - return - Is_Concurrent_Record_Type (Id) - and then Is_Protected_Type (Corresponding_Concurrent_Type (Id)); - end Is_Protected_Record_Type; - - ------------------------------------- - -- Is_Relaxed_Initialization_State -- - ------------------------------------- - - function Is_Relaxed_Initialization_State (Id : E) return B is - begin - -- To qualify, the abstract state must appear with simple option - -- "Relaxed_Initialization" (SPARK RM 6.10). - - return - Ekind (Id) = E_Abstract_State - and then Has_Option (Id, Name_Relaxed_Initialization); - end Is_Relaxed_Initialization_State; - - -------------------------------- - -- Is_Standard_Character_Type -- - -------------------------------- - - function Is_Standard_Character_Type (Id : E) return B is - begin - return Is_Type (Id) - and then Root_Type (Id) in Standard_Character - | Standard_Wide_Character - | Standard_Wide_Wide_Character; - end Is_Standard_Character_Type; - - ----------------------------- - -- Is_Standard_String_Type -- - ----------------------------- - - function Is_Standard_String_Type (Id : E) return B is - begin - return Is_Type (Id) - and then Root_Type (Id) in Standard_String - | Standard_Wide_String - | Standard_Wide_Wide_String; - end Is_Standard_String_Type; - - -------------------- - -- Is_String_Type -- - -------------------- - - function Is_String_Type (Id : E) return B is - begin - return Is_Array_Type (Id) - and then Id /= Any_Composite - and then Number_Dimensions (Id) = 1 - and then Is_Character_Type (Component_Type (Id)); - end Is_String_Type; - - ------------------------------- - -- Is_Synchronized_Interface -- - ------------------------------- - - function Is_Synchronized_Interface (Id : E) return B is - Typ : constant Entity_Id := Base_Type (Id); - - begin - if not Is_Interface (Typ) then - return False; - - elsif Is_Class_Wide_Type (Typ) then - return Is_Synchronized_Interface (Etype (Typ)); - - else - return Protected_Present (Type_Definition (Parent (Typ))) - or else Synchronized_Present (Type_Definition (Parent (Typ))) - or else Task_Present (Type_Definition (Parent (Typ))); - end if; - end Is_Synchronized_Interface; - - --------------------------- - -- Is_Synchronized_State -- - --------------------------- - - function Is_Synchronized_State (Id : E) return B is - begin - -- To qualify, the abstract state must appear with simple option - -- "synchronous" (SPARK RM 7.1.4(9)). - - return - Ekind (Id) = E_Abstract_State - and then Has_Option (Id, Name_Synchronous); - end Is_Synchronized_State; - - ----------------------- - -- Is_Task_Interface -- - ----------------------- - - function Is_Task_Interface (Id : E) return B is - Typ : constant Entity_Id := Base_Type (Id); - begin - if not Is_Interface (Typ) then - return False; - elsif Is_Class_Wide_Type (Typ) then - return Is_Task_Interface (Etype (Typ)); - else - return Task_Present (Type_Definition (Parent (Typ))); - end if; - end Is_Task_Interface; - - ------------------------- - -- Is_Task_Record_Type -- - ------------------------- - - function Is_Task_Record_Type (Id : E) return B is - begin - return - Is_Concurrent_Record_Type (Id) - and then Is_Task_Type (Corresponding_Concurrent_Type (Id)); - end Is_Task_Record_Type; - - ------------------------ - -- Is_Wrapper_Package -- - ------------------------ - - function Is_Wrapper_Package (Id : E) return B is - begin - return Ekind (Id) = E_Package and then Present (Related_Instance (Id)); - end Is_Wrapper_Package; - - ----------------- - -- Last_Formal -- - ----------------- - - function Last_Formal (Id : E) return E is - Formal : Entity_Id; - - begin - pragma Assert - (Is_Overloadable (Id) - or else Ekind (Id) in E_Entry_Family - | E_Subprogram_Body - | E_Subprogram_Type); - - if Ekind (Id) = E_Enumeration_Literal then - return Empty; - - else - Formal := First_Formal (Id); - - if Present (Formal) then - while Present (Next_Formal (Formal)) loop - Next_Formal (Formal); - end loop; - end if; - - return Formal; - end if; - end Last_Formal; - - ------------------- - -- Link_Entities -- - ------------------- - - procedure Link_Entities (First : Entity_Id; Second : Node_Id) is - begin - if Present (Second) then - Set_Prev_Entity (Second, First); -- First <-- Second - end if; - - Set_Next_Entity (First, Second); -- First --> Second - end Link_Entities; - - ------------------------ - -- Machine_Emax_Value -- - ------------------------ - - function Machine_Emax_Value (Id : E) return Uint is - Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id))); - - begin - case Float_Rep (Id) is - when IEEE_Binary => - case Digs is - when 1 .. 6 => return Uint_128; - when 7 .. 15 => return 2**10; - when 16 .. 33 => return 2**14; - when others => return No_Uint; - end case; - - when AAMP => - return Uint_2 ** Uint_7 - Uint_1; - end case; - end Machine_Emax_Value; - - ------------------------ - -- Machine_Emin_Value -- - ------------------------ - - function Machine_Emin_Value (Id : E) return Uint is - begin - case Float_Rep (Id) is - when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id); - when AAMP => return -Machine_Emax_Value (Id); - end case; - end Machine_Emin_Value; - - ---------------------------- - -- Machine_Mantissa_Value -- - ---------------------------- - - function Machine_Mantissa_Value (Id : E) return Uint is - Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id))); - - begin - case Float_Rep (Id) is - when IEEE_Binary => - case Digs is - when 1 .. 6 => return Uint_24; - when 7 .. 15 => return UI_From_Int (53); - when 16 .. 18 => return Uint_64; - when 19 .. 33 => return UI_From_Int (113); - when others => return No_Uint; - end case; - - when AAMP => - case Digs is - when 1 .. 6 => return Uint_24; - when 7 .. 9 => return UI_From_Int (40); - when others => return No_Uint; - end case; - end case; - end Machine_Mantissa_Value; - - ------------------------- - -- Machine_Radix_Value -- - ------------------------- - - function Machine_Radix_Value (Id : E) return U is - begin - case Float_Rep (Id) is - when AAMP - | IEEE_Binary - => - return Uint_2; - end case; - end Machine_Radix_Value; - - ---------------------- - -- Model_Emin_Value -- - ---------------------- - - function Model_Emin_Value (Id : E) return Uint is - begin - return Machine_Emin_Value (Id); - end Model_Emin_Value; - - ------------------------- - -- Model_Epsilon_Value -- - ------------------------- - - function Model_Epsilon_Value (Id : E) return Ureal is - Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); - begin - return Radix ** (1 - Model_Mantissa_Value (Id)); - end Model_Epsilon_Value; - - -------------------------- - -- Model_Mantissa_Value -- - -------------------------- - - function Model_Mantissa_Value (Id : E) return Uint is - begin - return Machine_Mantissa_Value (Id); - end Model_Mantissa_Value; - - ----------------------- - -- Model_Small_Value -- - ----------------------- - - function Model_Small_Value (Id : E) return Ureal is - Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); - begin - return Radix ** (Model_Emin_Value (Id) - 1); - end Model_Small_Value; - - -------------------- - -- Next_Component -- - -------------------- - - function Next_Component (Id : E) return E is - Comp_Id : Entity_Id; - - begin - Comp_Id := Next_Entity (Id); - while Present (Comp_Id) loop - exit when Ekind (Comp_Id) = E_Component; - Next_Entity (Comp_Id); - end loop; - - return Comp_Id; - end Next_Component; - - ------------------------------------ - -- Next_Component_Or_Discriminant -- - ------------------------------------ - - function Next_Component_Or_Discriminant (Id : E) return E is - Comp_Id : Entity_Id; - - begin - Comp_Id := Next_Entity (Id); - while Present (Comp_Id) loop - exit when Ekind (Comp_Id) in E_Component | E_Discriminant; - Next_Entity (Comp_Id); - end loop; - - return Comp_Id; - end Next_Component_Or_Discriminant; - - ----------------------- - -- Next_Discriminant -- - ----------------------- - - -- This function actually implements both Next_Discriminant and - -- Next_Stored_Discriminant by making sure that the Discriminant - -- returned is of the same variety as Id. - - function Next_Discriminant (Id : E) return E is - - -- Derived Tagged types with private extensions look like this... - - -- E_Discriminant d1 - -- E_Discriminant d2 - -- E_Component _tag - -- E_Discriminant d1 - -- E_Discriminant d2 - -- ... - - -- so it is critical not to go past the leading discriminants - - D : E := Id; - - begin - pragma Assert (Ekind (Id) = E_Discriminant); - - loop - Next_Entity (D); - if No (D) - or else (Ekind (D) /= E_Discriminant - and then not Is_Itype (D)) - then - return Empty; - end if; - - exit when Ekind (D) = E_Discriminant - and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id)); - end loop; - - return D; - end Next_Discriminant; - - ----------------- - -- Next_Formal -- - ----------------- - - function Next_Formal (Id : E) return E is - P : Entity_Id; - - begin - -- Follow the chain of declared entities as long as the kind of the - -- entity corresponds to a formal parameter. Skip internal entities - -- that may have been created for implicit subtypes, in the process - -- of analyzing default expressions. - - P := Id; - loop - Next_Entity (P); - - if No (P) or else Is_Formal (P) then - return P; - elsif not Is_Internal (P) then - return Empty; - end if; - end loop; - end Next_Formal; - - ----------------------------- - -- Next_Formal_With_Extras -- - ----------------------------- - - function Next_Formal_With_Extras (Id : E) return E is - begin - if Present (Extra_Formal (Id)) then - return Extra_Formal (Id); - else - return Next_Formal (Id); - end if; - end Next_Formal_With_Extras; - - ---------------- - -- Next_Index -- - ---------------- - - function Next_Index (Id : Node_Id) return Node_Id is - begin - return Next (Id); - end Next_Index; - - ------------------ - -- Next_Literal -- - ------------------ - - function Next_Literal (Id : E) return E is - begin - pragma Assert (Nkind (Id) in N_Entity); - return Next (Id); - end Next_Literal; - - ------------------------------ - -- Next_Stored_Discriminant -- - ------------------------------ - - function Next_Stored_Discriminant (Id : E) return E is - begin - -- See comment in Next_Discriminant - - return Next_Discriminant (Id); - end Next_Stored_Discriminant; - - ----------------------- - -- Number_Dimensions -- - ----------------------- - - function Number_Dimensions (Id : E) return Pos is - N : Int; - T : Node_Id; - - begin - if Ekind (Id) = E_String_Literal_Subtype then - return 1; - - else - N := 0; - T := First_Index (Id); - while Present (T) loop - N := N + 1; - Next_Index (T); - end loop; - - return N; - end if; - end Number_Dimensions; - - -------------------- - -- Number_Entries -- - -------------------- - - function Number_Entries (Id : E) return Nat is - N : Int; - Ent : Entity_Id; - - begin - pragma Assert (Is_Concurrent_Type (Id)); - - N := 0; - Ent := First_Entity (Id); - while Present (Ent) loop - if Is_Entry (Ent) then - N := N + 1; - end if; - - Next_Entity (Ent); - end loop; - - return N; - end Number_Entries; - - -------------------- - -- Number_Formals -- - -------------------- - - function Number_Formals (Id : E) return Pos is - N : Int; - Formal : Entity_Id; - - begin - N := 0; - Formal := First_Formal (Id); - while Present (Formal) loop - N := N + 1; - Next_Formal (Formal); - end loop; - - return N; - end Number_Formals; - - ------------------------ - -- Object_Size_Clause -- - ------------------------ - - function Object_Size_Clause (Id : E) return N is - begin - return Get_Attribute_Definition_Clause (Id, Attribute_Object_Size); - end Object_Size_Clause; - - -------------------- - -- Parameter_Mode -- - -------------------- - - function Parameter_Mode (Id : E) return Formal_Kind is - begin - return Ekind (Id); - end Parameter_Mode; - - --------------------------- - -- Partial_DIC_Procedure -- - --------------------------- - - function Partial_DIC_Procedure (Id : E) return E is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id)); - - Subps := Subprograms_For_Type (Base_Type (Id)); - - if Present (Subps) then - Subp_Elmt := First_Elmt (Subps); - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Is_Partial_DIC_Procedure (Subp_Id) then - return Subp_Id; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end if; - - return Empty; - end Partial_DIC_Procedure; - - --------------------------------- - -- Partial_Invariant_Procedure -- - --------------------------------- - - function Partial_Invariant_Procedure (Id : E) return E is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id)); - - Subps := Subprograms_For_Type (Base_Type (Id)); - - if Present (Subps) then - Subp_Elmt := First_Elmt (Subps); - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Is_Partial_Invariant_Procedure (Subp_Id) then - return Subp_Id; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end if; - - return Empty; - end Partial_Invariant_Procedure; - - ------------------------------------- - -- Partial_Refinement_Constituents -- - ------------------------------------- - - function Partial_Refinement_Constituents (Id : E) return L is - Constits : Elist_Id := No_Elist; - - procedure Add_Usable_Constituents (Item : E); - -- Add global item Item and/or its constituents to list Constits when - -- they can be used in a global refinement within the current scope. The - -- criteria are: - -- 1) If Item is an abstract state with full refinement visible, add - -- its constituents. - -- 2) If Item is an abstract state with only partial refinement - -- visible, add both Item and its constituents. - -- 3) If Item is an abstract state without a visible refinement, add - -- it. - -- 4) If Id is not an abstract state, add it. - - procedure Add_Usable_Constituents (List : Elist_Id); - -- Apply Add_Usable_Constituents to every constituent in List - - ----------------------------- - -- Add_Usable_Constituents -- - ----------------------------- - - procedure Add_Usable_Constituents (Item : E) is - begin - if Ekind (Item) = E_Abstract_State then - if Has_Visible_Refinement (Item) then - Add_Usable_Constituents (Refinement_Constituents (Item)); - - elsif Has_Partial_Visible_Refinement (Item) then - Append_New_Elmt (Item, Constits); - Add_Usable_Constituents (Part_Of_Constituents (Item)); - - else - Append_New_Elmt (Item, Constits); - end if; - - else - Append_New_Elmt (Item, Constits); - end if; - end Add_Usable_Constituents; - - procedure Add_Usable_Constituents (List : Elist_Id) is - Constit_Elmt : Elmt_Id; - begin - if Present (List) then - Constit_Elmt := First_Elmt (List); - while Present (Constit_Elmt) loop - Add_Usable_Constituents (Node (Constit_Elmt)); - Next_Elmt (Constit_Elmt); - end loop; - end if; - end Add_Usable_Constituents; - - -- Start of processing for Partial_Refinement_Constituents - - begin - -- "Refinement" is a concept applicable only to abstract states - - pragma Assert (Ekind (Id) = E_Abstract_State); - - if Has_Visible_Refinement (Id) then - Constits := Refinement_Constituents (Id); - - -- A refinement may be partially visible when objects declared in the - -- private part of a package are subject to a Part_Of indicator. - - elsif Has_Partial_Visible_Refinement (Id) then - Add_Usable_Constituents (Part_Of_Constituents (Id)); - - -- Function should only be called when full or partial refinement is - -- visible. - - else - raise Program_Error; - end if; - - return Constits; - end Partial_Refinement_Constituents; - - ------------------------ - -- Predicate_Function -- - ------------------------ - - function Predicate_Function (Id : E) return E is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - Typ : Entity_Id; - - begin - pragma Assert (Is_Type (Id)); - - -- If type is private and has a completion, predicate may be defined on - -- the full view. - - if Is_Private_Type (Id) - and then - (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id))) - and then Present (Full_View (Id)) - then - Typ := Full_View (Id); - - elsif Ekind (Id) in E_Array_Subtype - | E_Record_Subtype - | E_Record_Subtype_With_Private - and then Present (Predicated_Parent (Id)) - then - Typ := Predicated_Parent (Id); - - else - Typ := Id; - end if; - - Subps := Subprograms_For_Type (Typ); - - if Present (Subps) then - Subp_Elmt := First_Elmt (Subps); - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Ekind (Subp_Id) = E_Function - and then Is_Predicate_Function (Subp_Id) - then - return Subp_Id; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end if; - - return Empty; - end Predicate_Function; - - -------------------------- - -- Predicate_Function_M -- - -------------------------- - - function Predicate_Function_M (Id : E) return E is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - Typ : Entity_Id; - - begin - pragma Assert (Is_Type (Id)); - - -- If type is private and has a completion, predicate may be defined on - -- the full view. - - if Is_Private_Type (Id) - and then - (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id))) - and then Present (Full_View (Id)) - then - Typ := Full_View (Id); - - else - Typ := Id; - end if; - - Subps := Subprograms_For_Type (Typ); - - if Present (Subps) then - Subp_Elmt := First_Elmt (Subps); - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Ekind (Subp_Id) = E_Function - and then Is_Predicate_Function_M (Subp_Id) - then - return Subp_Id; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end if; - - return Empty; - end Predicate_Function_M; - - ------------------------- - -- Present_In_Rep_Item -- - ------------------------- - - function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean is - Ritem : Node_Id; - - begin - Ritem := First_Rep_Item (E); - - while Present (Ritem) loop - if Ritem = N then - return True; - end if; - - Next_Rep_Item (Ritem); - end loop; - - return False; - end Present_In_Rep_Item; - - -------------------------- - -- Primitive_Operations -- - -------------------------- - - function Primitive_Operations (Id : E) return L is - begin - if Is_Concurrent_Type (Id) then - if Present (Corresponding_Record_Type (Id)) then - return Direct_Primitive_Operations - (Corresponding_Record_Type (Id)); - - -- If expansion is disabled the corresponding record type is absent, - -- but if the type has ancestors it may have primitive operations. - - elsif Is_Tagged_Type (Id) then - return Direct_Primitive_Operations (Id); - - else - return No_Elist; - end if; - else - return Direct_Primitive_Operations (Id); - end if; - end Primitive_Operations; - - --------------------- - -- Record_Rep_Item -- - --------------------- - - procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is - begin - Set_Next_Rep_Item (N, First_Rep_Item (E)); - Set_First_Rep_Item (E, N); - end Record_Rep_Item; - - ------------------- - -- Remove_Entity -- - ------------------- - - procedure Remove_Entity (Id : Entity_Id) is - Next : constant Entity_Id := Next_Entity (Id); - Prev : constant Entity_Id := Prev_Entity (Id); - Scop : constant Entity_Id := Scope (Id); - First : constant Entity_Id := First_Entity (Scop); - Last : constant Entity_Id := Last_Entity (Scop); - - begin - -- Eliminate any existing linkages from the entity - - Set_Prev_Entity (Id, Empty); -- Empty <-- Id - Set_Next_Entity (Id, Empty); -- Id --> Empty - - -- The eliminated entity was the only element in the entity chain - - if Id = First and then Id = Last then - Set_First_Entity (Scop, Empty); - Set_Last_Entity (Scop, Empty); - - -- The eliminated entity was the head of the entity chain - - elsif Id = First then - Set_First_Entity (Scop, Next); - - -- The eliminated entity was the tail of the entity chain - - elsif Id = Last then - Set_Last_Entity (Scop, Prev); - - -- Otherwise the eliminated entity comes from the middle of the entity - -- chain. - - else - Link_Entities (Prev, Next); -- Prev <-- Next, Prev --> Next - end if; - end Remove_Entity; - - --------------- - -- Root_Type -- - --------------- - - function Root_Type (Id : E) return E is - T, Etyp : Entity_Id; - - begin - pragma Assert (Nkind (Id) in N_Entity); - - T := Base_Type (Id); - - if Ekind (T) = E_Class_Wide_Type then - return Etype (T); - - -- Other cases - - else - loop - Etyp := Etype (T); - - if T = Etyp then - return T; - - -- Following test catches some error cases resulting from - -- previous errors. - - elsif No (Etyp) then - Check_Error_Detected; - return T; - - elsif Is_Private_Type (T) and then Etyp = Full_View (T) then - return T; - - elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then - return T; - end if; - - T := Etyp; - - -- Return if there is a circularity in the inheritance chain. This - -- happens in some error situations and we do not want to get - -- stuck in this loop. - - if T = Base_Type (Id) then - return T; - end if; - end loop; - end if; - end Root_Type; - - --------------------- - -- Safe_Emax_Value -- - --------------------- - - function Safe_Emax_Value (Id : E) return Uint is - begin - return Machine_Emax_Value (Id); - end Safe_Emax_Value; - - ---------------------- - -- Safe_First_Value -- - ---------------------- - - function Safe_First_Value (Id : E) return Ureal is - begin - return -Safe_Last_Value (Id); - end Safe_First_Value; - - --------------------- - -- Safe_Last_Value -- - --------------------- - - function Safe_Last_Value (Id : E) return Ureal is - Radix : constant Uint := Machine_Radix_Value (Id); - Mantissa : constant Uint := Machine_Mantissa_Value (Id); - Emax : constant Uint := Safe_Emax_Value (Id); - Significand : constant Uint := Radix ** Mantissa - 1; - Exponent : constant Uint := Emax - Mantissa; - - begin - if Radix = 2 then - return - UR_From_Components - (Num => Significand * 2 ** (Exponent mod 4), - Den => -Exponent / 4, - Rbase => 16); - else - return - UR_From_Components - (Num => Significand, - Den => -Exponent, - Rbase => 16); - end if; - end Safe_Last_Value; - - ----------------- - -- Scope_Depth -- - ----------------- - - function Scope_Depth (Id : E) return Uint is - Scop : Entity_Id; - - begin - Scop := Id; - while Is_Record_Type (Scop) loop - Scop := Scope (Scop); - end loop; - - return Scope_Depth_Value (Scop); - end Scope_Depth; - - --------------------- - -- Scope_Depth_Set -- - --------------------- - - function Scope_Depth_Set (Id : E) return B is - begin - return not Is_Record_Type (Id) - and then Field22 (Id) /= Union_Id (Empty); - end Scope_Depth_Set; - - ----------------------------- - -- Set_Component_Alignment -- - ----------------------------- - - -- Component Alignment is encoded using two flags, Flag128/129 as - -- follows. Note that both flags False = Align_Default, so that the - -- default initialization of flags to False initializes component - -- alignment to the default value as required. - - -- Flag128 Flag129 Value - -- ------- ------- ----- - -- False False Calign_Default - -- False True Calign_Component_Size - -- True False Calign_Component_Size_4 - -- True True Calign_Storage_Unit - - procedure Set_Component_Alignment (Id : E; V : C) is - begin - pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id)) - and then Is_Base_Type (Id)); - - case V is - when Calign_Default => - Set_Flag128 (Id, False); - Set_Flag129 (Id, False); - - when Calign_Component_Size => - Set_Flag128 (Id, False); - Set_Flag129 (Id, True); - - when Calign_Component_Size_4 => - Set_Flag128 (Id, True); - Set_Flag129 (Id, False); - - when Calign_Storage_Unit => - Set_Flag128 (Id, True); - Set_Flag129 (Id, True); - end case; - end Set_Component_Alignment; - - ----------------------- - -- Set_DIC_Procedure -- - ----------------------- - - procedure Set_DIC_Procedure (Id : E; V : E) is - Base_Typ : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id)); - - Base_Typ := Base_Type (Id); - Subps := Subprograms_For_Type (Base_Typ); - - if No (Subps) then - Subps := New_Elmt_List; - Set_Subprograms_For_Type (Base_Typ, Subps); - end if; - - Prepend_Elmt (V, Subps); - end Set_DIC_Procedure; - - ------------------------------------- - -- Set_Partial_Invariant_Procedure -- - ------------------------------------- - - procedure Set_Partial_DIC_Procedure (Id : E; V : E) is - begin - Set_DIC_Procedure (Id, V); - end Set_Partial_DIC_Procedure; - - ----------------------------- - -- Set_Invariant_Procedure -- - ----------------------------- - - procedure Set_Invariant_Procedure (Id : E; V : E) is - Base_Typ : Entity_Id; - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id)); - - Base_Typ := Base_Type (Id); - Subps := Subprograms_For_Type (Base_Typ); - - if No (Subps) then - Subps := New_Elmt_List; - Set_Subprograms_For_Type (Base_Typ, Subps); - end if; - - Subp_Elmt := First_Elmt (Subps); - Prepend_Elmt (V, Subps); - - -- Check for a duplicate invariant procedure - - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Is_Invariant_Procedure (Subp_Id) then - raise Program_Error; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end Set_Invariant_Procedure; - - ------------------------------------- - -- Set_Partial_Invariant_Procedure -- - ------------------------------------- - - procedure Set_Partial_Invariant_Procedure (Id : E; V : E) is - Base_Typ : Entity_Id; - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id)); - - Base_Typ := Base_Type (Id); - Subps := Subprograms_For_Type (Base_Typ); - - if No (Subps) then - Subps := New_Elmt_List; - Set_Subprograms_For_Type (Base_Typ, Subps); - end if; - - Subp_Elmt := First_Elmt (Subps); - Prepend_Elmt (V, Subps); - - -- Check for a duplicate partial invariant procedure - - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Is_Partial_Invariant_Procedure (Subp_Id) then - raise Program_Error; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end Set_Partial_Invariant_Procedure; - - ---------------------------- - -- Set_Predicate_Function -- - ---------------------------- - - procedure Set_Predicate_Function (Id : E; V : E) is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id) and then Has_Predicates (Id)); - - Subps := Subprograms_For_Type (Id); - - if No (Subps) then - Subps := New_Elmt_List; - Set_Subprograms_For_Type (Id, Subps); - end if; - - Subp_Elmt := First_Elmt (Subps); - Prepend_Elmt (V, Subps); - - -- Check for a duplicate predication function - - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Ekind (Subp_Id) = E_Function - and then Is_Predicate_Function (Subp_Id) - then - raise Program_Error; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end Set_Predicate_Function; - - ------------------------------ - -- Set_Predicate_Function_M -- - ------------------------------ - - procedure Set_Predicate_Function_M (Id : E; V : E) is - Subp_Elmt : Elmt_Id; - Subp_Id : Entity_Id; - Subps : Elist_Id; - - begin - pragma Assert (Is_Type (Id) and then Has_Predicates (Id)); - - Subps := Subprograms_For_Type (Id); - - if No (Subps) then - Subps := New_Elmt_List; - Set_Subprograms_For_Type (Id, Subps); - end if; - - Subp_Elmt := First_Elmt (Subps); - Prepend_Elmt (V, Subps); - - -- Check for a duplicate predication function - - while Present (Subp_Elmt) loop - Subp_Id := Node (Subp_Elmt); - - if Ekind (Subp_Id) = E_Function - and then Is_Predicate_Function_M (Subp_Id) - then - raise Program_Error; - end if; - - Next_Elmt (Subp_Elmt); - end loop; - end Set_Predicate_Function_M; - - ----------------- - -- Size_Clause -- - ----------------- - - function Size_Clause (Id : E) return N is - begin - return Get_Attribute_Definition_Clause (Id, Attribute_Size); - end Size_Clause; - - ------------------------ - -- Stream_Size_Clause -- - ------------------------ - - function Stream_Size_Clause (Id : E) return N is - begin - return Get_Attribute_Definition_Clause (Id, Attribute_Stream_Size); - end Stream_Size_Clause; - - ------------------ - -- Subtype_Kind -- - ------------------ - - function Subtype_Kind (K : Entity_Kind) return Entity_Kind is - Kind : Entity_Kind; - - begin - case K is - when Access_Kind => - Kind := E_Access_Subtype; - - when E_Array_Subtype - | E_Array_Type - => - Kind := E_Array_Subtype; - - when E_Class_Wide_Subtype - | E_Class_Wide_Type - => - Kind := E_Class_Wide_Subtype; - - when E_Decimal_Fixed_Point_Subtype - | E_Decimal_Fixed_Point_Type - => - Kind := E_Decimal_Fixed_Point_Subtype; - - when E_Ordinary_Fixed_Point_Subtype - | E_Ordinary_Fixed_Point_Type - => - Kind := E_Ordinary_Fixed_Point_Subtype; - - when E_Private_Subtype - | E_Private_Type - => - Kind := E_Private_Subtype; - - when E_Limited_Private_Subtype - | E_Limited_Private_Type - => - Kind := E_Limited_Private_Subtype; - - when E_Record_Subtype_With_Private - | E_Record_Type_With_Private - => - Kind := E_Record_Subtype_With_Private; - - when E_Record_Subtype - | E_Record_Type - => - Kind := E_Record_Subtype; - - when Enumeration_Kind => - Kind := E_Enumeration_Subtype; - - when E_Incomplete_Type => - Kind := E_Incomplete_Subtype; - - when Float_Kind => - Kind := E_Floating_Point_Subtype; - - when Signed_Integer_Kind => - Kind := E_Signed_Integer_Subtype; - - when Modular_Integer_Kind => - Kind := E_Modular_Integer_Subtype; - - when Protected_Kind => - Kind := E_Protected_Subtype; - - when Task_Kind => - Kind := E_Task_Subtype; - - when others => - Kind := E_Void; - raise Program_Error; - end case; - - return Kind; - end Subtype_Kind; - - --------------------- - -- Type_High_Bound -- - --------------------- - - function Type_High_Bound (Id : E) return Node_Id is - Rng : constant Node_Id := Scalar_Range (Id); - begin - if Nkind (Rng) = N_Subtype_Indication then - return High_Bound (Range_Expression (Constraint (Rng))); - else - return High_Bound (Rng); - end if; - end Type_High_Bound; - - -------------------- - -- Type_Low_Bound -- - -------------------- - - function Type_Low_Bound (Id : E) return Node_Id is - Rng : constant Node_Id := Scalar_Range (Id); - begin - if Nkind (Rng) = N_Subtype_Indication then - return Low_Bound (Range_Expression (Constraint (Rng))); - else - return Low_Bound (Rng); - end if; - end Type_Low_Bound; - - --------------------- - -- Underlying_Type -- - --------------------- - - function Underlying_Type (Id : E) return E is - begin - -- For record_with_private the underlying type is always the direct full - -- view. Never try to take the full view of the parent it does not make - -- sense. - - if Ekind (Id) = E_Record_Type_With_Private then - return Full_View (Id); - - -- If we have a class-wide type that comes from the limited view then we - -- return the Underlying_Type of its nonlimited view. - - elsif Ekind (Id) = E_Class_Wide_Type - and then From_Limited_With (Id) - and then Present (Non_Limited_View (Id)) - then - return Underlying_Type (Non_Limited_View (Id)); - - elsif Ekind (Id) in Incomplete_Or_Private_Kind then - - -- If we have an incomplete or private type with a full view, then we - -- return the Underlying_Type of this full view. - - if Present (Full_View (Id)) then - if Id = Full_View (Id) then - - -- Previous error in declaration - - return Empty; - - else - return Underlying_Type (Full_View (Id)); - end if; - - -- If we have a private type with an underlying full view, then we - -- return the Underlying_Type of this underlying full view. - - elsif Ekind (Id) in Private_Kind - and then Present (Underlying_Full_View (Id)) - then - return Underlying_Type (Underlying_Full_View (Id)); - - -- If we have an incomplete entity that comes from the limited view - -- then we return the Underlying_Type of its nonlimited view. - - elsif From_Limited_With (Id) - and then Present (Non_Limited_View (Id)) - then - return Underlying_Type (Non_Limited_View (Id)); - - -- Otherwise check for the case where we have a derived type or - -- subtype, and if so get the Underlying_Type of the parent type. - - elsif Etype (Id) /= Id then - return Underlying_Type (Etype (Id)); - - -- Otherwise we have an incomplete or private type that has no full - -- view, which means that we have not encountered the completion, so - -- return Empty to indicate the underlying type is not yet known. - - else - return Empty; - end if; - - -- For non-incomplete, non-private types, return the type itself. Also - -- for entities that are not types at all return the entity itself. - - else - return Id; - end if; - end Underlying_Type; - - ------------------------ - -- Unlink_Next_Entity -- - ------------------------ - - procedure Unlink_Next_Entity (Id : Entity_Id) is - Next : constant Entity_Id := Next_Entity (Id); - - begin - if Present (Next) then - Set_Prev_Entity (Next, Empty); -- Empty <-- Next - end if; - - Set_Next_Entity (Id, Empty); -- Id --> Empty - end Unlink_Next_Entity; - - ------------------------ - -- Write_Entity_Flags -- - ------------------------ - - procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String) is - - procedure W (Flag_Name : String; Flag : Boolean); - -- Write out given flag if it is set - - ------- - -- W -- - ------- - - procedure W (Flag_Name : String; Flag : Boolean) is - begin - if Flag then - Write_Str (Prefix); - Write_Str (Flag_Name); - Write_Str (" = True"); - Write_Eol; - end if; - end W; - - -- Start of processing for Write_Entity_Flags - - begin - if (Is_Array_Type (Id) or else Is_Record_Type (Id)) - and then Is_Base_Type (Id) - then - Write_Str (Prefix); - Write_Str ("Component_Alignment = "); - - case Component_Alignment (Id) is - when Calign_Default => - Write_Str ("Calign_Default"); - - when Calign_Component_Size => - Write_Str ("Calign_Component_Size"); - - when Calign_Component_Size_4 => - Write_Str ("Calign_Component_Size_4"); - - when Calign_Storage_Unit => - Write_Str ("Calign_Storage_Unit"); - end case; - - Write_Eol; - end if; - - W ("Address_Taken", Flag104 (Id)); - W ("Body_Needed_For_Inlining", Flag299 (Id)); - W ("Body_Needed_For_SAL", Flag40 (Id)); - W ("C_Pass_By_Copy", Flag125 (Id)); - W ("Can_Never_Be_Null", Flag38 (Id)); - W ("Checks_May_Be_Suppressed", Flag31 (Id)); - W ("Contains_Ignored_Ghost_Code", Flag279 (Id)); - W ("Debug_Info_Off", Flag166 (Id)); - W ("Default_Expressions_Processed", Flag108 (Id)); - W ("Delay_Cleanups", Flag114 (Id)); - W ("Delay_Subprogram_Descriptors", Flag50 (Id)); - W ("Depends_On_Private", Flag14 (Id)); - W ("Discard_Names", Flag88 (Id)); - W ("Elaboration_Entity_Required", Flag174 (Id)); - W ("Elaborate_Body_Desirable", Flag210 (Id)); - W ("Entry_Accepted", Flag152 (Id)); - W ("Can_Use_Internal_Rep", Flag229 (Id)); - W ("Finalize_Storage_Only", Flag158 (Id)); - W ("From_Limited_With", Flag159 (Id)); - W ("Has_Aliased_Components", Flag135 (Id)); - W ("Has_Alignment_Clause", Flag46 (Id)); - W ("Has_All_Calls_Remote", Flag79 (Id)); - W ("Has_Atomic_Components", Flag86 (Id)); - W ("Has_Biased_Representation", Flag139 (Id)); - W ("Has_Completion", Flag26 (Id)); - W ("Has_Completion_In_Body", Flag71 (Id)); - W ("Has_Complex_Representation", Flag140 (Id)); - W ("Has_Component_Size_Clause", Flag68 (Id)); - W ("Has_Contiguous_Rep", Flag181 (Id)); - W ("Has_Controlled_Component", Flag43 (Id)); - W ("Has_Controlling_Result", Flag98 (Id)); - W ("Has_Convention_Pragma", Flag119 (Id)); - W ("Has_Default_Aspect", Flag39 (Id)); - W ("Has_Delayed_Aspects", Flag200 (Id)); - W ("Has_Delayed_Freeze", Flag18 (Id)); - W ("Has_Delayed_Rep_Aspects", Flag261 (Id)); - W ("Has_Discriminants", Flag5 (Id)); - W ("Has_Dispatch_Table", Flag220 (Id)); - W ("Has_Dynamic_Predicate_Aspect", Flag258 (Id)); - W ("Has_Enumeration_Rep_Clause", Flag66 (Id)); - W ("Has_Exit", Flag47 (Id)); - W ("Has_Expanded_Contract", Flag240 (Id)); - W ("Has_Forward_Instantiation", Flag175 (Id)); - W ("Has_Fully_Qualified_Name", Flag173 (Id)); - W ("Has_Gigi_Rep_Item", Flag82 (Id)); - W ("Has_Homonym", Flag56 (Id)); - W ("Has_Implicit_Dereference", Flag251 (Id)); - W ("Has_Independent_Components", Flag34 (Id)); - W ("Has_Inheritable_Invariants", Flag248 (Id)); - W ("Has_Inherited_DIC", Flag133 (Id)); - W ("Has_Inherited_Invariants", Flag291 (Id)); - W ("Has_Initial_Value", Flag219 (Id)); - W ("Has_Loop_Entry_Attributes", Flag260 (Id)); - W ("Has_Machine_Radix_Clause", Flag83 (Id)); - W ("Has_Master_Entity", Flag21 (Id)); - W ("Has_Missing_Return", Flag142 (Id)); - W ("Has_Nested_Block_With_Handler", Flag101 (Id)); - W ("Has_Nested_Subprogram", Flag282 (Id)); - W ("Has_Non_Standard_Rep", Flag75 (Id)); - W ("Has_Out_Or_In_Out_Parameter", Flag110 (Id)); - W ("Has_Object_Size_Clause", Flag172 (Id)); - W ("Has_Own_DIC", Flag3 (Id)); - W ("Has_Own_Invariants", Flag232 (Id)); - W ("Has_Per_Object_Constraint", Flag154 (Id)); - W ("Has_Pragma_Controlled", Flag27 (Id)); - W ("Has_Pragma_Elaborate_Body", Flag150 (Id)); - W ("Has_Pragma_Inline", Flag157 (Id)); - W ("Has_Pragma_Inline_Always", Flag230 (Id)); - W ("Has_Pragma_No_Inline", Flag201 (Id)); - W ("Has_Pragma_Ordered", Flag198 (Id)); - W ("Has_Pragma_Pack", Flag121 (Id)); - W ("Has_Pragma_Preelab_Init", Flag221 (Id)); - W ("Has_Pragma_Pure", Flag203 (Id)); - W ("Has_Pragma_Pure_Function", Flag179 (Id)); - W ("Has_Pragma_Thread_Local_Storage", Flag169 (Id)); - W ("Has_Pragma_Unmodified", Flag233 (Id)); - W ("Has_Pragma_Unreferenced", Flag180 (Id)); - W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id)); - W ("Has_Pragma_Unused", Flag294 (Id)); - W ("Has_Predicates", Flag250 (Id)); - W ("Has_Primitive_Operations", Flag120 (Id)); - W ("Has_Private_Ancestor", Flag151 (Id)); - W ("Has_Private_Declaration", Flag155 (Id)); - W ("Has_Private_Extension", Flag300 (Id)); - W ("Has_Protected", Flag271 (Id)); - W ("Has_Qualified_Name", Flag161 (Id)); - W ("Has_RACW", Flag214 (Id)); - W ("Has_Record_Rep_Clause", Flag65 (Id)); - W ("Has_Recursive_Call", Flag143 (Id)); - W ("Has_Shift_Operator", Flag267 (Id)); - W ("Has_Size_Clause", Flag29 (Id)); - W ("Has_Small_Clause", Flag67 (Id)); - W ("Has_Specified_Layout", Flag100 (Id)); - W ("Has_Specified_Stream_Input", Flag190 (Id)); - W ("Has_Specified_Stream_Output", Flag191 (Id)); - W ("Has_Specified_Stream_Read", Flag192 (Id)); - W ("Has_Specified_Stream_Write", Flag193 (Id)); - W ("Has_Static_Discriminants", Flag211 (Id)); - W ("Has_Static_Predicate", Flag269 (Id)); - W ("Has_Static_Predicate_Aspect", Flag259 (Id)); - W ("Has_Storage_Size_Clause", Flag23 (Id)); - W ("Has_Stream_Size_Clause", Flag184 (Id)); - W ("Has_Task", Flag30 (Id)); - W ("Has_Timing_Event", Flag289 (Id)); - W ("Has_Thunks", Flag228 (Id)); - W ("Has_Unchecked_Union", Flag123 (Id)); - W ("Has_Unknown_Discriminants", Flag72 (Id)); - W ("Has_Visible_Refinement", Flag263 (Id)); - W ("Has_Volatile_Components", Flag87 (Id)); - W ("Has_Xref_Entry", Flag182 (Id)); - W ("Has_Yield_Aspect", Flag308 (Id)); - W ("Ignore_SPARK_Mode_Pragmas", Flag301 (Id)); - W ("In_Package_Body", Flag48 (Id)); - W ("In_Private_Part", Flag45 (Id)); - W ("In_Use", Flag8 (Id)); - W ("Is_Abstract_Subprogram", Flag19 (Id)); - W ("Is_Abstract_Type", Flag146 (Id)); - W ("Is_Access_Constant", Flag69 (Id)); - W ("Is_Activation_Record", Flag305 (Id)); - W ("Is_Actual_Subtype", Flag293 (Id)); - W ("Is_Ada_2005_Only", Flag185 (Id)); - W ("Is_Ada_2012_Only", Flag199 (Id)); - W ("Is_Aliased", Flag15 (Id)); - W ("Is_Asynchronous", Flag81 (Id)); - W ("Is_Atomic", Flag85 (Id)); - W ("Is_Bit_Packed_Array", Flag122 (Id)); - W ("Is_CPP_Class", Flag74 (Id)); - W ("Is_CUDA_Kernel", Flag118 (Id)); - W ("Is_Called", Flag102 (Id)); - W ("Is_Character_Type", Flag63 (Id)); - W ("Is_Checked_Ghost_Entity", Flag277 (Id)); - W ("Is_Child_Unit", Flag73 (Id)); - W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id)); - W ("Is_Compilation_Unit", Flag149 (Id)); - W ("Is_Completely_Hidden", Flag103 (Id)); - W ("Is_Concurrent_Record_Type", Flag20 (Id)); - W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id)); - W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id)); - W ("Is_Constrained", Flag12 (Id)); - W ("Is_Constructor", Flag76 (Id)); - W ("Is_Controlled_Active", Flag42 (Id)); - W ("Is_Controlling_Formal", Flag97 (Id)); - W ("Is_Descendant_Of_Address", Flag223 (Id)); - W ("Is_DIC_Procedure", Flag132 (Id)); - W ("Is_Discrim_SO_Function", Flag176 (Id)); - W ("Is_Discriminant_Check_Function", Flag264 (Id)); - W ("Is_Dispatch_Table_Entity", Flag234 (Id)); - W ("Is_Dispatching_Operation", Flag6 (Id)); - W ("Is_Elaboration_Checks_OK_Id", Flag148 (Id)); - W ("Is_Elaboration_Warnings_OK_Id", Flag304 (Id)); - W ("Is_Eliminated", Flag124 (Id)); - W ("Is_Entry_Formal", Flag52 (Id)); - W ("Is_Exception_Handler", Flag286 (Id)); - W ("Is_Exported", Flag99 (Id)); - W ("Is_Finalized_Transient", Flag252 (Id)); - W ("Is_First_Subtype", Flag70 (Id)); - W ("Is_Formal_Subprogram", Flag111 (Id)); - W ("Is_Frozen", Flag4 (Id)); - W ("Is_Generic_Actual_Subprogram", Flag274 (Id)); - W ("Is_Generic_Actual_Type", Flag94 (Id)); - W ("Is_Generic_Instance", Flag130 (Id)); - W ("Is_Generic_Type", Flag13 (Id)); - W ("Is_Hidden", Flag57 (Id)); - W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id)); - W ("Is_Hidden_Open_Scope", Flag171 (Id)); - W ("Is_Ignored_Ghost_Entity", Flag278 (Id)); - W ("Is_Ignored_Transient", Flag295 (Id)); - W ("Is_Immediately_Visible", Flag7 (Id)); - W ("Is_Implementation_Defined", Flag254 (Id)); - W ("Is_Imported", Flag24 (Id)); - W ("Is_Independent", Flag268 (Id)); - W ("Is_Initial_Condition_Procedure", Flag302 (Id)); - W ("Is_Inlined", Flag11 (Id)); - W ("Is_Inlined_Always", Flag1 (Id)); - W ("Is_Instantiated", Flag126 (Id)); - W ("Is_Interface", Flag186 (Id)); - W ("Is_Internal", Flag17 (Id)); - W ("Is_Interrupt_Handler", Flag89 (Id)); - W ("Is_Intrinsic_Subprogram", Flag64 (Id)); - W ("Is_Invariant_Procedure", Flag257 (Id)); - W ("Is_Itype", Flag91 (Id)); - W ("Is_Known_Non_Null", Flag37 (Id)); - W ("Is_Known_Null", Flag204 (Id)); - W ("Is_Known_Valid", Flag170 (Id)); - W ("Is_Limited_Composite", Flag106 (Id)); - W ("Is_Limited_Interface", Flag197 (Id)); - W ("Is_Limited_Record", Flag25 (Id)); - W ("Is_Local_Anonymous_Access", Flag194 (Id)); - W ("Is_Loop_Parameter", Flag307 (Id)); - W ("Is_Machine_Code_Subprogram", Flag137 (Id)); - W ("Is_Non_Static_Subtype", Flag109 (Id)); - W ("Is_Null_Init_Proc", Flag178 (Id)); - W ("Is_Obsolescent", Flag153 (Id)); - W ("Is_Only_Out_Parameter", Flag226 (Id)); - W ("Is_Package_Body_Entity", Flag160 (Id)); - W ("Is_Packed", Flag51 (Id)); - W ("Is_Packed_Array_Impl_Type", Flag138 (Id)); - W ("Is_Param_Block_Component_Type", Flag215 (Id)); - W ("Is_Partial_Invariant_Procedure", Flag292 (Id)); - W ("Is_Potentially_Use_Visible", Flag9 (Id)); - W ("Is_Predicate_Function", Flag255 (Id)); - W ("Is_Predicate_Function_M", Flag256 (Id)); - W ("Is_Preelaborated", Flag59 (Id)); - W ("Is_Primitive", Flag218 (Id)); - W ("Is_Primitive_Wrapper", Flag195 (Id)); - W ("Is_Private_Composite", Flag107 (Id)); - W ("Is_Private_Descendant", Flag53 (Id)); - W ("Is_Private_Primitive", Flag245 (Id)); - W ("Is_Public", Flag10 (Id)); - W ("Is_Pure", Flag44 (Id)); - W ("Is_Pure_Unit_Access_Type", Flag189 (Id)); - W ("Is_RACW_Stub_Type", Flag244 (Id)); - W ("Is_Raised", Flag224 (Id)); - W ("Is_Remote_Call_Interface", Flag62 (Id)); - W ("Is_Remote_Types", Flag61 (Id)); - W ("Is_Renaming_Of_Object", Flag112 (Id)); - W ("Is_Return_Object", Flag209 (Id)); - W ("Is_Safe_To_Reevaluate", Flag249 (Id)); - W ("Is_Shared_Passive", Flag60 (Id)); - W ("Is_Static_Type", Flag281 (Id)); - W ("Is_Statically_Allocated", Flag28 (Id)); - W ("Is_Tag", Flag78 (Id)); - W ("Is_Tagged_Type", Flag55 (Id)); - W ("Is_Thunk", Flag225 (Id)); - W ("Is_Trivial_Subprogram", Flag235 (Id)); - W ("Is_True_Constant", Flag163 (Id)); - W ("Is_Unchecked_Union", Flag117 (Id)); - W ("Is_Underlying_Full_View", Flag298 (Id)); - W ("Is_Underlying_Record_View", Flag246 (Id)); - W ("Is_Unimplemented", Flag284 (Id)); - W ("Is_Unsigned_Type", Flag144 (Id)); - W ("Is_Uplevel_Referenced_Entity", Flag283 (Id)); - W ("Is_Valued_Procedure", Flag127 (Id)); - W ("Is_Visible_Formal", Flag206 (Id)); - W ("Is_Visible_Lib_Unit", Flag116 (Id)); - W ("Is_Volatile", Flag16 (Id)); - W ("Is_Volatile_Full_Access", Flag285 (Id)); - W ("Itype_Printed", Flag202 (Id)); - W ("Kill_Elaboration_Checks", Flag32 (Id)); - W ("Kill_Range_Checks", Flag33 (Id)); - W ("Known_To_Have_Preelab_Init", Flag207 (Id)); - W ("Low_Bound_Tested", Flag205 (Id)); - W ("Machine_Radix_10", Flag84 (Id)); - W ("Materialize_Entity", Flag168 (Id)); - W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id)); - W ("Must_Be_On_Byte_Boundary", Flag183 (Id)); - W ("Must_Have_Preelab_Init", Flag208 (Id)); - W ("Needs_Activation_Record", Flag306 (Id)); - W ("Needs_Debug_Info", Flag147 (Id)); - W ("Needs_No_Actuals", Flag22 (Id)); - W ("Never_Set_In_Source", Flag115 (Id)); - W ("No_Dynamic_Predicate_On_actual", Flag276 (Id)); - W ("No_Pool_Assigned", Flag131 (Id)); - W ("No_Predicate_On_actual", Flag275 (Id)); - W ("No_Reordering", Flag239 (Id)); - W ("No_Return", Flag113 (Id)); - W ("No_Strict_Aliasing", Flag136 (Id)); - W ("Non_Binary_Modulus", Flag58 (Id)); - W ("Nonzero_Is_True", Flag162 (Id)); - W ("OK_To_Rename", Flag247 (Id)); - W ("Optimize_Alignment_Space", Flag241 (Id)); - W ("Optimize_Alignment_Time", Flag242 (Id)); - W ("Overlays_Constant", Flag243 (Id)); - W ("Partial_View_Has_Unknown_Discr", Flag280 (Id)); - W ("Reachable", Flag49 (Id)); - W ("Referenced", Flag156 (Id)); - W ("Referenced_As_LHS", Flag36 (Id)); - W ("Referenced_As_Out_Parameter", Flag227 (Id)); - W ("Renamed_In_Spec", Flag231 (Id)); - W ("Requires_Overriding", Flag213 (Id)); - W ("Return_Present", Flag54 (Id)); - W ("Returns_By_Ref", Flag90 (Id)); - W ("Reverse_Bit_Order", Flag164 (Id)); - W ("Reverse_Storage_Order", Flag93 (Id)); - W ("Rewritten_For_C", Flag287 (Id)); - W ("Predicates_Ignored", Flag288 (Id)); - W ("Sec_Stack_Needed_For_Return", Flag167 (Id)); - W ("Size_Depends_On_Discriminant", Flag177 (Id)); - W ("Size_Known_At_Compile_Time", Flag92 (Id)); - W ("SPARK_Aux_Pragma_Inherited", Flag266 (Id)); - W ("SPARK_Pragma_Inherited", Flag265 (Id)); - W ("SSO_Set_High_By_Default", Flag273 (Id)); - W ("SSO_Set_Low_By_Default", Flag272 (Id)); - W ("Static_Elaboration_Desired", Flag77 (Id)); - W ("Stores_Attribute_Old_Prefix", Flag270 (Id)); - W ("Strict_Alignment", Flag145 (Id)); - W ("Suppress_Elaboration_Warnings", Flag303 (Id)); - W ("Suppress_Initialization", Flag105 (Id)); - W ("Suppress_Style_Checks", Flag165 (Id)); - W ("Suppress_Value_Tracking_On_Call", Flag217 (Id)); - W ("Treat_As_Volatile", Flag41 (Id)); - W ("Universal_Aliasing", Flag216 (Id)); - W ("Used_As_Generic_Actual", Flag222 (Id)); - W ("Uses_Sec_Stack", Flag95 (Id)); - W ("Warnings_Off", Flag96 (Id)); - W ("Warnings_Off_Used", Flag236 (Id)); - W ("Warnings_Off_Used_Unmodified", Flag237 (Id)); - W ("Warnings_Off_Used_Unreferenced", Flag238 (Id)); - W ("Was_Hidden", Flag196 (Id)); - end Write_Entity_Flags; - - ----------------------- - -- Write_Entity_Info -- - ----------------------- - - procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is - - procedure Write_Attribute (Which : String; Nam : E); - -- Write attribute value with given string name - - procedure Write_Kind (Id : Entity_Id); - -- Write Ekind field of entity - - --------------------- - -- Write_Attribute -- - --------------------- - - procedure Write_Attribute (Which : String; Nam : E) is - begin - Write_Str (Prefix); - Write_Str (Which); - Write_Int (Int (Nam)); - Write_Str (" "); - Write_Name (Chars (Nam)); - Write_Str (" "); - end Write_Attribute; - - ---------------- - -- Write_Kind -- - ---------------- - - procedure Write_Kind (Id : Entity_Id) is - K : constant String := Entity_Kind'Image (Ekind (Id)); - - begin - Write_Str (Prefix); - Write_Str (" Kind "); - - if Is_Type (Id) and then Is_Tagged_Type (Id) then - Write_Str ("TAGGED "); - end if; - - Write_Str (K (3 .. K'Length)); - Write_Str (" "); - - if Is_Type (Id) and then Depends_On_Private (Id) then - Write_Str ("Depends_On_Private "); - end if; - end Write_Kind; - - -- Start of processing for Write_Entity_Info - - begin - Write_Eol; - Write_Attribute ("Name ", Id); - Write_Int (Int (Id)); - Write_Eol; - Write_Kind (Id); - Write_Eol; - Write_Attribute (" Type ", Etype (Id)); - Write_Eol; - if Id /= Standard_Standard then - Write_Attribute (" Scope ", Scope (Id)); - end if; - Write_Eol; - - case Ekind (Id) is - when Discrete_Kind => - Write_Str ("Bounds: Id = "); - - if Present (Scalar_Range (Id)) then - Write_Int (Int (Type_Low_Bound (Id))); - Write_Str (" .. Id = "); - Write_Int (Int (Type_High_Bound (Id))); - else - Write_Str ("Empty"); - end if; - - Write_Eol; - - when Array_Kind => - declare - Index : Entity_Id; - - begin - Write_Attribute - (" Component Type ", Component_Type (Id)); - Write_Eol; - Write_Str (Prefix); - Write_Str (" Indexes "); - - Index := First_Index (Id); - while Present (Index) loop - Write_Attribute (" ", Etype (Index)); - Index := Next_Index (Index); - end loop; - - Write_Eol; - end; - - when Access_Kind => - Write_Attribute - (" Directly Designated Type ", - Directly_Designated_Type (Id)); - Write_Eol; - - when Overloadable_Kind => - if Present (Homonym (Id)) then - Write_Str (" Homonym "); - Write_Name (Chars (Homonym (Id))); - Write_Str (" "); - Write_Int (Int (Homonym (Id))); - Write_Eol; - end if; - - Write_Eol; - - when E_Component => - if Is_Record_Type (Scope (Id)) then - Write_Attribute ( - " Original_Record_Component ", - Original_Record_Component (Id)); - Write_Int (Int (Original_Record_Component (Id))); - Write_Eol; - end if; - - when others => - null; - end case; - end Write_Entity_Info; - - ----------------------- - -- Write_Field6_Name -- - ----------------------- - - procedure Write_Field6_Name (Id : Entity_Id) is - pragma Unreferenced (Id); - begin - Write_Str ("First_Rep_Item"); - end Write_Field6_Name; - - ----------------------- - -- Write_Field7_Name -- - ----------------------- - - procedure Write_Field7_Name (Id : Entity_Id) is - pragma Unreferenced (Id); - begin - Write_Str ("Freeze_Node"); - end Write_Field7_Name; - - ----------------------- - -- Write_Field8_Name -- - ----------------------- - - procedure Write_Field8_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Type_Kind => - Write_Str ("Associated_Node_For_Itype"); - - when E_Package => - Write_Str ("Dependent_Instances"); - - when E_Loop => - Write_Str ("First_Exit_Statement"); - - when E_Variable => - Write_Str ("Hiding_Loop_Variable"); - - when Formal_Kind - | E_Function - | E_Subprogram_Body - => - Write_Str ("Mechanism"); - - when E_Component - | E_Discriminant - => - Write_Str ("Normalized_First_Bit"); - - when E_Abstract_State => - Write_Str ("Refinement_Constituents"); - - when E_Block - | E_Return_Statement - => - Write_Str ("Return_Applies_To"); - - when others => - Write_Str ("Field8??"); - end case; - end Write_Field8_Name; - - ----------------------- - -- Write_Field9_Name -- - ----------------------- - - procedure Write_Field9_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Type_Kind => - Write_Str ("Class_Wide_Type"); - - when Object_Kind => - Write_Str ("Current_Value"); - - when E_Function - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Package - | E_Procedure - => - Write_Str ("Renaming_Map"); - - when others => - Write_Str ("Field9??"); - end case; - end Write_Field9_Name; - - ------------------------ - -- Write_Field10_Name -- - ------------------------ - - procedure Write_Field10_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Class_Wide_Kind - | Incomplete_Kind - | E_Record_Type - | E_Record_Subtype - | Private_Kind - | Concurrent_Kind - => - Write_Str ("Direct_Primitive_Operations"); - - when E_Constant - | E_In_Parameter - => - Write_Str ("Discriminal_Link"); - - when Float_Kind => - Write_Str ("Float_Rep"); - - when E_Function - | E_Package - | E_Package_Body - | E_Procedure - => - Write_Str ("Handler_Records"); - - when E_Component - | E_Discriminant - => - Write_Str ("Normalized_Position_Max"); - - when E_Abstract_State - | E_Variable - => - Write_Str ("Part_Of_Constituents"); - - when others => - Write_Str ("Field10??"); - end case; - end Write_Field10_Name; - - ------------------------ - -- Write_Field11_Name -- - ------------------------ - - procedure Write_Field11_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Block => - Write_Str ("Block_Node"); - - when E_Component - | E_Discriminant - => - Write_Str ("Component_Bit_Offset"); - - when Formal_Kind => - Write_Str ("Entry_Component"); - - when E_Enumeration_Literal => - Write_Str ("Enumeration_Pos"); - - when Type_Kind - | E_Constant - => - Write_Str ("Full_View"); - - when E_Generic_Package => - Write_Str ("Generic_Homonym"); - - when E_Variable => - Write_Str ("Part_Of_References"); - - when E_Entry - | E_Entry_Family - | E_Function - | E_Procedure - => - Write_Str ("Protected_Body_Subprogram"); - - when others => - Write_Str ("Field11??"); - end case; - end Write_Field11_Name; - - ------------------------ - -- Write_Field12_Name -- - ------------------------ - - procedure Write_Field12_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Package => - Write_Str ("Associated_Formal_Package"); - - when Entry_Kind => - Write_Str ("Barrier_Function"); - - when E_Enumeration_Literal => - Write_Str ("Enumeration_Rep"); - - when Type_Kind - | E_Component - | E_Constant - | E_Discriminant - | E_Exception - | E_In_Parameter - | E_In_Out_Parameter - | E_Out_Parameter - | E_Loop_Parameter - | E_Variable - => - Write_Str ("Esize"); - - when E_Function - | E_Procedure - => - Write_Str ("Next_Inlined_Subprogram"); - - when others => - Write_Str ("Field12??"); - end case; - end Write_Field12_Name; - - ------------------------ - -- Write_Field13_Name -- - ------------------------ - - procedure Write_Field13_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Component - | E_Discriminant - => - Write_Str ("Component_Clause"); - - when E_Entry - | E_Entry_Family - | E_Function - | E_Procedure - | E_Package - | Generic_Unit_Kind - => - Write_Str ("Elaboration_Entity"); - - when Formal_Kind - | E_Variable - => - Write_Str ("Extra_Accessibility"); - - when Type_Kind => - Write_Str ("RM_Size"); - - when others => - Write_Str ("Field13??"); - end case; - end Write_Field13_Name; - - ----------------------- - -- Write_Field14_Name -- - ----------------------- - - procedure Write_Field14_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Type_Kind - | Formal_Kind - | E_Constant - | E_Exception - | E_Loop_Parameter - | E_Variable - => - Write_Str ("Alignment"); - - when E_Component - | E_Discriminant - => - Write_Str ("Normalized_Position"); - - when E_Entry - | E_Entry_Family - | E_Function - | E_Procedure - => - Write_Str ("Postconditions_Proc"); - - when others => - Write_Str ("Field14??"); - end case; - end Write_Field14_Name; - - ------------------------ - -- Write_Field15_Name -- - ------------------------ - - procedure Write_Field15_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Discriminant => - Write_Str ("Discriminant_Number"); - - when E_Component => - Write_Str ("DT_Entry_Count"); - - when E_Function - | E_Procedure - => - Write_Str ("DT_Position"); - - when Entry_Kind => - Write_Str ("Entry_Parameters_Type"); - - when Formal_Kind => - Write_Str ("Extra_Formal"); - - when Type_Kind => - Write_Str ("Pending_Access_Types"); - - when E_Package - | E_Package_Body - => - Write_Str ("Related_Instance"); - - when E_Constant - | E_Loop_Parameter - | E_Variable - => - Write_Str ("Status_Flag_Or_Transient_Decl"); - - when others => - Write_Str ("Field15??"); - end case; - end Write_Field15_Name; - - ------------------------ - -- Write_Field16_Name -- - ------------------------ - - procedure Write_Field16_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Record_Type - | E_Record_Type_With_Private - => - Write_Str ("Access_Disp_Table"); - - when E_Abstract_State => - Write_Str ("Body_References"); - - when E_Class_Wide_Subtype - | E_Record_Subtype - => - Write_Str ("Cloned_Subtype"); - - when E_Function - | E_Procedure - => - Write_Str ("DTC_Entity"); - - when E_Component => - Write_Str ("Entry_Formal"); - - when Concurrent_Kind - | E_Generic_Package - | E_Package - => - Write_Str ("First_Private_Entity"); - - when Enumeration_Kind => - Write_Str ("Lit_Strings"); - - when Decimal_Fixed_Point_Kind => - Write_Str ("Scale_Value"); - - when E_String_Literal_Subtype => - Write_Str ("String_Literal_Length"); - - when E_Out_Parameter - | E_Variable - => - Write_Str ("Unset_Reference"); - - when others => - Write_Str ("Field16??"); - end case; - end Write_Field16_Name; - - ------------------------ - -- Write_Field17_Name -- - ------------------------ - - procedure Write_Field17_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Formal_Kind - | E_Constant - | E_Generic_In_Out_Parameter - | E_Variable - => - Write_Str ("Actual_Subtype"); - - when Digits_Kind => - Write_Str ("Digits_Value"); - - when E_Discriminant => - Write_Str ("Discriminal"); - - when Class_Wide_Kind - | Concurrent_Kind - | Private_Kind - | E_Block - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Loop - | E_Operator - | E_Package - | E_Package_Body - | E_Procedure - | E_Record_Type - | E_Record_Subtype - | E_Return_Statement - | E_Subprogram_Body - | E_Subprogram_Type - => - Write_Str ("First_Entity"); - - when Array_Kind => - Write_Str ("First_Index"); - - when Enumeration_Kind => - Write_Str ("First_Literal"); - - when Access_Kind => - Write_Str ("Master_Id"); - - when Modular_Integer_Kind => - Write_Str ("Modulus"); - - when E_Component => - Write_Str ("Prival"); - - when others => - Write_Str ("Field17??"); - end case; - end Write_Field17_Name; - - ------------------------ - -- Write_Field18_Name -- - ------------------------ - - procedure Write_Field18_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Enumeration_Literal - | E_Function - | E_Operator - | E_Procedure - => - Write_Str ("Alias"); - - when E_Record_Type => - Write_Str ("Corresponding_Concurrent_Type"); - - when E_Subprogram_Body => - Write_Str ("Corresponding_Protected_Entry"); - - when Concurrent_Kind => - Write_Str ("Corresponding_Record_Type"); - - when E_Block - | E_Label - | E_Loop - => - Write_Str ("Enclosing_Scope"); - - when E_Entry_Index_Parameter => - Write_Str ("Entry_Index_Constant"); - - when E_Access_Protected_Subprogram_Type - | E_Access_Subprogram_Type - | E_Anonymous_Access_Protected_Subprogram_Type - | E_Exception_Type - | E_Class_Wide_Subtype - => - Write_Str ("Equivalent_Type"); - - when Fixed_Point_Kind => - Write_Str ("Delta_Value"); - - when Enumeration_Kind => - Write_Str ("Lit_Indexes"); - - when Incomplete_Or_Private_Kind - | E_Record_Subtype - => - Write_Str ("Private_Dependents"); - - when E_Exception - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Package - => - Write_Str ("Renamed_Entity"); - - when Object_Kind => - Write_Str ("Renamed_Object"); - - when E_String_Literal_Subtype => - Write_Str ("String_Literal_Low_Bound"); - - when others => - Write_Str ("Field18??"); - end case; - end Write_Field18_Name; - - ----------------------- - -- Write_Field19_Name -- - ----------------------- - - procedure Write_Field19_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Generic_Package - | E_Package - => - Write_Str ("Body_Entity"); - - when E_Discriminant => - Write_Str ("Corresponding_Discriminant"); - - when Scalar_Kind => - Write_Str ("Default_Aspect_Value"); - - when E_Array_Type => - Write_Str ("Default_Component_Value"); - - when E_Protected_Type => - Write_Str ("Entry_Bodies_Array"); - - when E_Function - | E_Operator - | E_Subprogram_Type - => - Write_Str ("Extra_Accessibility_Of_Result"); - - when E_Abstract_State - | E_Class_Wide_Type - | E_Incomplete_Type - => - Write_Str ("Non_Limited_View"); - - when E_Incomplete_Subtype => - if From_Limited_With (Id) then - Write_Str ("Non_Limited_View"); - end if; - - when E_Record_Type => - Write_Str ("Parent_Subtype"); - - when E_Procedure => - Write_Str ("Receiving_Entry"); - - when E_Constant - | E_Variable - => - Write_Str ("Size_Check_Code"); - - when Formal_Kind - | E_Package_Body - => - Write_Str ("Spec_Entity"); - - when Private_Kind => - Write_Str ("Underlying_Full_View"); - - when others => - Write_Str ("Field19??"); - end case; - end Write_Field19_Name; - - ----------------------- - -- Write_Field20_Name -- - ----------------------- - - procedure Write_Field20_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Array_Kind => - Write_Str ("Component_Type"); - - when E_Generic_In_Parameter - | E_In_Parameter - => - Write_Str ("Default_Value"); - - when Access_Kind => - Write_Str ("Directly_Designated_Type"); - - when E_Component => - Write_Str ("Discriminant_Checking_Func"); - - when E_Discriminant => - Write_Str ("Discriminant_Default_Value"); - - when Class_Wide_Kind - | Concurrent_Kind - | Private_Kind - | E_Block - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Loop - | E_Operator - | E_Package - | E_Package_Body - | E_Procedure - | E_Record_Type - | E_Record_Subtype - | E_Return_Statement - | E_Subprogram_Body - | E_Subprogram_Type - => - Write_Str ("Last_Entity"); - - when E_Constant - | E_Variable - => - Write_Str ("Prival_Link"); - - when E_Exception => - Write_Str ("Register_Exception_Call"); - - when Scalar_Kind => - Write_Str ("Scalar_Range"); - - when others => - Write_Str ("Field20??"); - end case; - end Write_Field20_Name; - - ----------------------- - -- Write_Field21_Name -- - ----------------------- - - procedure Write_Field21_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Entry_Kind => - Write_Str ("Accept_Address"); - - when E_Component - | E_Discriminant - => - Write_Str ("Corresponding_Record_Component"); - - when E_In_Parameter => - Write_Str ("Default_Expr_Function"); - - when Concurrent_Kind - | Incomplete_Or_Private_Kind - | Class_Wide_Kind - | E_Record_Type - | E_Record_Subtype - => - Write_Str ("Discriminant_Constraint"); - - when E_Constant - | E_Exception - | E_Function - | E_Generic_Function - | E_Generic_Procedure - | E_Procedure - | E_Variable - => - Write_Str ("Interface_Name"); - - when Enumeration_Kind => - Write_Str ("Lit_Hash"); - - when Array_Kind - | Modular_Integer_Kind - => - Write_Str ("Original_Array_Type"); - - when Fixed_Point_Kind => - Write_Str ("Small_Value"); - - when others => - Write_Str ("Field21??"); - end case; - end Write_Field21_Name; - - ----------------------- - -- Write_Field22_Name -- - ----------------------- - - procedure Write_Field22_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Access_Kind => - Write_Str ("Associated_Storage_Pool"); - - when Array_Kind => - Write_Str ("Component_Size"); - - when E_Record_Type => - Write_Str ("Corresponding_Remote_Type"); - - when E_Component - | E_Discriminant - => - Write_Str ("Original_Record_Component"); - - when E_Enumeration_Literal => - Write_Str ("Enumeration_Rep_Expr"); - - when Formal_Kind => - Write_Str ("Protected_Formal"); - - when Concurrent_Kind - | Entry_Kind - | Generic_Unit_Kind - | E_Package - | E_Package_Body - | Subprogram_Kind - | E_Block - | E_Subprogram_Body - | E_Private_Type .. E_Limited_Private_Subtype - | E_Void - | E_Loop - | E_Return_Statement - => - Write_Str ("Scope_Depth_Value"); - - when E_Variable => - Write_Str ("Shared_Var_Procs_Instance"); - - when others => - Write_Str ("Field22??"); - end case; - end Write_Field22_Name; - - ------------------------ - -- Write_Field23_Name -- - ------------------------ - - procedure Write_Field23_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Discriminant => - Write_Str ("CR_Discriminant"); - - when E_Block => - Write_Str ("Entry_Cancel_Parameter"); - - when E_Enumeration_Type => - Write_Str ("Enum_Pos_To_Rep"); - - when Formal_Kind - | E_Variable - => - Write_Str ("Extra_Constrained"); - - when Access_Kind => - Write_Str ("Finalization_Master"); - - when E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - => - Write_Str ("Inner_Instances"); - - when Array_Kind => - Write_Str ("Packed_Array_Impl_Type"); - - when Entry_Kind => - Write_Str ("Protection_Object"); - - when Class_Wide_Kind - | Concurrent_Kind - | Incomplete_Or_Private_Kind - | E_Record_Type - | E_Record_Subtype - => - Write_Str ("Stored_Constraint"); - - when E_Function - | E_Procedure - => - if Present (Scope (Id)) - and then Is_Protected_Type (Scope (Id)) - then - Write_Str ("Protection_Object"); - else - Write_Str ("Generic_Renamings"); - end if; - - when E_Package => - if Is_Generic_Instance (Id) then - Write_Str ("Generic_Renamings"); - else - Write_Str ("Limited_View"); - end if; - - when others => - Write_Str ("Field23??"); - end case; - end Write_Field23_Name; - - ------------------------ - -- Write_Field24_Name -- - ------------------------ - - procedure Write_Field24_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Package => - Write_Str ("Incomplete_Actuals"); - - when Type_Kind - | E_Constant - | E_Loop_Parameter - | E_Variable - => - Write_Str ("Related_Expression"); - - when Formal_Kind => - Write_Str ("Minimum_Accessibility"); - - when E_Function - | E_Operator - | E_Procedure - => - Write_Str ("Subps_Index"); - - when others => - Write_Str ("Field24???"); - end case; - end Write_Field24_Name; - - ------------------------ - -- Write_Field25_Name -- - ------------------------ - - procedure Write_Field25_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Generic_Package - | E_Package - => - Write_Str ("Abstract_States"); - - when E_Entry - | E_Entry_Family - => - Write_Str ("Contract_Wrapper"); - - when E_Variable => - Write_Str ("Debug_Renaming_Link"); - - when E_Component => - Write_Str ("DT_Offset_To_Top_Func"); - - when E_Function - | E_Procedure - => - Write_Str ("Interface_Alias"); - - when E_Record_Subtype - | E_Record_Subtype_With_Private - | E_Record_Type - | E_Record_Type_With_Private - => - Write_Str ("Interfaces"); - - when E_Array_Subtype - | E_Array_Type - => - Write_Str ("Related_Array_Object"); - - when Discrete_Kind => - Write_Str ("Static_Discrete_Predicate"); - - when Real_Kind => - Write_Str ("Static_Real_Or_String_Predicate"); - - when Task_Kind => - Write_Str ("Task_Body_Procedure"); - - when others => - Write_Str ("Field25??"); - end case; - end Write_Field25_Name; - - ------------------------ - -- Write_Field26_Name -- - ------------------------ - - procedure Write_Field26_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Record_Type - | E_Record_Type_With_Private - => - Write_Str ("Dispatch_Table_Wrappers"); - - when E_In_Out_Parameter - | E_Out_Parameter - | E_Variable - => - Write_Str ("Last_Assignment"); - - when E_Function - | E_Procedure - => - Write_Str ("Overridden_Operation"); - - when E_Generic_Package - | E_Package - => - Write_Str ("Package_Instantiation"); - - when E_Component - | E_Constant - => - Write_Str ("Related_Type"); - - when Access_Kind - | Task_Kind - => - Write_Str ("Storage_Size_Variable"); - - when others => - Write_Str ("Field26??"); - end case; - end Write_Field26_Name; - - ------------------------ - -- Write_Field27_Name -- - ------------------------ - - procedure Write_Field27_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Type_Kind - | E_Package - => - Write_Str ("Current_Use_Clause"); - - when E_Component - | E_Constant - | E_Variable - => - Write_Str ("Related_Type"); - - when E_Function - | E_Procedure - => - Write_Str ("Wrapped_Entity"); - - when others => - Write_Str ("Field27??"); - end case; - end Write_Field27_Name; - - ------------------------ - -- Write_Field28_Name -- - ------------------------ - - procedure Write_Field28_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Entry - | E_Entry_Family - | E_Function - | E_Procedure - | E_Subprogram_Body - | E_Subprogram_Type - => - Write_Str ("Extra_Formals"); - - when E_Package - | E_Package_Body - => - Write_Str ("Finalizer"); - - when E_Constant - | E_Variable - => - Write_Str ("Initialization_Statements"); - - when E_Access_Subprogram_Type => - Write_Str ("Original_Access_Type"); - - when Task_Kind => - Write_Str ("Relative_Deadline_Variable"); - - when E_Record_Type => - Write_Str ("Underlying_Record_View"); - - when others => - Write_Str ("Field28??"); - end case; - end Write_Field28_Name; - - ------------------------ - -- Write_Field29_Name -- - ------------------------ - - procedure Write_Field29_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Function - | E_Package - | E_Procedure - | E_Subprogram_Body - => - Write_Str ("Anonymous_Masters"); - - when E_Constant - | E_Variable - => - Write_Str ("BIP_Initialization_Call"); - - when Type_Kind => - Write_Str ("Subprograms_For_Type"); - - when others => - Write_Str ("Field29??"); - end case; - end Write_Field29_Name; - - ------------------------ - -- Write_Field30_Name -- - ------------------------ - - procedure Write_Field30_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Record_Type - | E_Record_Type_With_Private - => - Write_Str ("Access_Disp_Table_Elab_Flag"); - - when E_Protected_Type - | E_Task_Type - => - Write_Str ("Anonymous_Object"); - - when E_Function => - Write_Str ("Corresponding_Equality"); - - when E_Constant - | E_Variable - => - Write_Str ("Last_Aggregate_Assignment"); - - when E_Procedure => - Write_Str ("Static_Initialization"); - - when others => - Write_Str ("Field30??"); - end case; - end Write_Field30_Name; - - ------------------------ - -- Write_Field31_Name -- - ------------------------ - - procedure Write_Field31_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Constant - | E_In_Parameter - | E_In_Out_Parameter - | E_Loop_Parameter - | E_Out_Parameter - | E_Variable - => - Write_Str ("Activation_Record_Component"); - - when Type_Kind => - Write_Str ("Derived_Type_Link"); - - when E_Function - | E_Procedure - => - Write_Str ("Thunk_Entity"); - - when others => - Write_Str ("Field31??"); - end case; - end Write_Field31_Name; - - ------------------------ - -- Write_Field32_Name -- - ------------------------ - - procedure Write_Field32_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Procedure => - Write_Str ("Corresponding_Function"); - - when E_Function => - Write_Str ("Corresponding_Procedure"); - - when E_Abstract_State - | E_Constant - | E_Variable - => - Write_Str ("Encapsulating_State"); - - when Type_Kind => - Write_Str ("No_Tagged_Streams_Pragma"); - - when others => - Write_Str ("Field32??"); - end case; - end Write_Field32_Name; - - ------------------------ - -- Write_Field33_Name -- - ------------------------ - - procedure Write_Field33_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when Subprogram_Kind - | Type_Kind - | E_Constant - | E_Variable - => - Write_Str ("Linker_Section_Pragma"); - - when others => - Write_Str ("Field33??"); - end case; - end Write_Field33_Name; - - ------------------------ - -- Write_Field34_Name -- - ------------------------ - - procedure Write_Field34_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Constant - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Operator - | E_Package - | E_Package_Body - | E_Procedure - | E_Subprogram_Body - | E_Task_Body - | E_Variable - | Type_Kind - | E_Void - => - Write_Str ("Contract"); - - when others => - Write_Str ("Field34??"); - end case; - end Write_Field34_Name; - - ------------------------ - -- Write_Field35_Name -- - ------------------------ - - procedure Write_Field35_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Variable => - Write_Str ("Anonymous_Designated_Type"); - - when E_Entry - | E_Entry_Family - => - Write_Str ("Entry_Max_Queue_Lenghts_Array"); - - when Subprogram_Kind => - Write_Str ("Import_Pragma"); - - when others => - Write_Str ("Field35??"); - end case; - end Write_Field35_Name; - - ------------------------ - -- Write_Field36_Name -- - ------------------------ - - procedure Write_Field36_Name (Id : Entity_Id) is - pragma Unreferenced (Id); - begin - Write_Str ("Prev_Entity"); - end Write_Field36_Name; - - ------------------------ - -- Write_Field37_Name -- - ------------------------ - - procedure Write_Field37_Name (Id : Entity_Id) is - pragma Unreferenced (Id); - begin - Write_Str ("Associated_Entity"); - end Write_Field37_Name; - - ------------------------ - -- Write_Field38_Name -- - ------------------------ - - procedure Write_Field38_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Function - | E_Procedure - => - Write_Str ("Class_Wide_Clone"); - - when E_Array_Subtype - | E_Record_Subtype - | E_Record_Subtype_With_Private - => - Write_Str ("Predicated_Parent"); - - when E_Variable => - Write_Str ("Validated_Object"); - - when others => - Write_Str ("Field38??"); - end case; - end Write_Field38_Name; - - ------------------------ - -- Write_Field39_Name -- - ------------------------ - - procedure Write_Field39_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Function - | E_Procedure - => - Write_Str ("Protected_Subprogram"); - - when others => - Write_Str ("Field39??"); - end case; - end Write_Field39_Name; - - ------------------------ - -- Write_Field40_Name -- - ------------------------ - - procedure Write_Field40_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Abstract_State - | E_Constant - | E_Entry - | E_Entry_Family - | E_Function - | E_Generic_Function - | E_Generic_Package - | E_Generic_Procedure - | E_Operator - | E_Package - | E_Package_Body - | E_Procedure - | E_Protected_Body - | E_Subprogram_Body - | E_Task_Body - | E_Variable - | E_Void - | Type_Kind - => - Write_Str ("SPARK_Pragma"); - - when others => - Write_Str ("Field40??"); - end case; - end Write_Field40_Name; - - ------------------------ - -- Write_Field41_Name -- - ------------------------ - - procedure Write_Field41_Name (Id : Entity_Id) is - begin - case Ekind (Id) is - when E_Function - | E_Procedure - => - Write_Str ("Original_Protected_Subprogram"); - - when E_Generic_Package - | E_Package - | E_Package_Body - | E_Protected_Type - | E_Task_Type - => - Write_Str ("SPARK_Aux_Pragma"); - - when E_Subprogram_Type => - Write_Str ("Access_Subprogram_Wrapper"); - - when others => - Write_Str ("Field41??"); - end case; - end Write_Field41_Name; - - ------------------------- - -- Iterator Procedures -- - ------------------------- - - procedure Proc_Next_Component (N : in out Node_Id) is - begin - N := Next_Component (N); - end Proc_Next_Component; - - procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is - begin - N := Next_Entity (N); - while Present (N) loop - exit when Ekind (N) in E_Component | E_Discriminant; - N := Next_Entity (N); - end loop; - end Proc_Next_Component_Or_Discriminant; - - procedure Proc_Next_Discriminant (N : in out Node_Id) is - begin - N := Next_Discriminant (N); - end Proc_Next_Discriminant; - - procedure Proc_Next_Formal (N : in out Node_Id) is - begin - N := Next_Formal (N); - end Proc_Next_Formal; - - procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is - begin - N := Next_Formal_With_Extras (N); - end Proc_Next_Formal_With_Extras; - - procedure Proc_Next_Index (N : in out Node_Id) is - begin - N := Next_Index (N); - end Proc_Next_Index; - - procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is - begin - N := Next_Inlined_Subprogram (N); - end Proc_Next_Inlined_Subprogram; - - procedure Proc_Next_Literal (N : in out Node_Id) is - begin - N := Next_Literal (N); - end Proc_Next_Literal; - - procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is - begin - N := Next_Stored_Discriminant (N); - end Proc_Next_Stored_Discriminant; - -end Einfo; +pragma No_Body; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index dff9c45f6a6..3995f8ed43f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -23,13 +23,19 @@ -- -- ------------------------------------------------------------------------------ +pragma Warnings (Off); -- with/use clauses for children +with Namet; use Namet; with Snames; use Snames; -with Types; use Types; -with Uintp; use Uintp; +with Stand; use Stand; +with Types; use Types; +with Uintp; use Uintp; with Urealp; use Urealp; +pragma Warnings (On); package Einfo is +-- ????Comments below are partly obsolete + -- This package defines the annotations to the abstract syntax tree that -- are needed to support semantic processing of an Ada compilation. @@ -993,7 +999,7 @@ package Einfo is -- Designated_Type obtains this full type in the case of access to an -- incomplete type. --- Disable_Controlled (Flag253) +-- Disable_Controlled (Flag253) [base type only] -- Present in all entities. Set for a controlled type subject to aspect -- Disable_Controlled which evaluates to True. This flag is taken into -- account in synthesized attribute Is_Controlled. @@ -1457,7 +1463,7 @@ package Einfo is -- Note in particular that size clauses are defined only for this -- purpose, and should only be accessed if Has_Size_Clause is set. --- Float_Rep (Uint10) +-- Float_Rep (Uint10) [base type only] -- Defined in floating-point entities. Contains a value of type -- Float_Rep_Kind. Together with the Digits_Value uniquely defines -- the floating-point representation to be used. @@ -3416,6 +3422,8 @@ package Einfo is -- Similarly, any front end test which is concerned with suppressing -- optimizations on volatile objects should test Treat_As_Volatile -- rather than testing this flag. +-- ????This has been split into Is_Volatile_Type and Is_Volatile_Object, +-- and function Is_Volatile is in Einfo.Utils. -- Is_Volatile_Full_Access (Flag285) -- Defined in all type entities, and also in constants, components, and @@ -4739,6 +4747,8 @@ package Einfo is -- Renaming and Aliasing -- --------------------------- +-- ???The following comments are not quite right; see Einfo.Utils. + -- Several entity attributes relate to renaming constructs, and to the use of -- different names to refer to the same entity. The following is a summary of -- these constructs and their prefered uses. @@ -4849,759 +4859,7 @@ package Einfo is -------------------------------- -- Classification of Entities -- -------------------------------- - --- The classification of program entities which follows is a refinement of --- the list given in RM 3.1(1). E.g., separate entities denote subtypes of --- different type classes. Ada 95 entities include class wide types, --- protected types, subprogram types, generalized access types, generic --- formal derived types and generic formal packages. - --- The order chosen for these kinds allows us to classify related entities --- so that they are contiguous. As a result, they do not appear in the --- exact same order as their order of first appearance in the LRM (For --- example, private types are listed before packages). The contiguity --- allows us to define useful subtypes (see below) such as type entities, --- overloaded entities, etc. - --- Each entity (explicitly or implicitly declared) has a kind, which is --- a value of the following type: - - type Entity_Kind is ( - - E_Void, - -- The initial Ekind value for a newly created entity. Also used as the - -- Ekind for Standard_Void_Type, a type entity in Standard used as a - -- dummy type for the return type of a procedure (the reason we create - -- this type is to share the circuits for performing overload resolution - -- on calls). - - ------------- - -- Objects -- - ------------- - - E_Component, - -- Components of a record declaration, private declarations of - -- protected objects. - - E_Constant, - -- Constants created by an object declaration with a constant keyword - - E_Discriminant, - -- A discriminant, created by the use of a discriminant in a type - -- declaration. - - E_Loop_Parameter, - -- A loop parameter created by a for loop - - E_Variable, - -- Variables created by an object declaration with no constant keyword - - ------------------------ - -- Parameter Entities -- - ------------------------ - - -- Parameters are also objects - - E_Out_Parameter, - -- An out parameter of a subprogram or entry - - E_In_Out_Parameter, - -- An in-out parameter of a subprogram or entry - - E_In_Parameter, - -- An in parameter of a subprogram or entry - - -------------------------------- - -- Generic Parameter Entities -- - -------------------------------- - - -- Generic parameters are also objects - - E_Generic_In_Out_Parameter, - -- A generic in out parameter, created by the use of a generic in out - -- parameter in a generic declaration. - - E_Generic_In_Parameter, - -- A generic in parameter, created by the use of a generic in - -- parameter in a generic declaration. - - ------------------- - -- Named Numbers -- - ------------------- - - E_Named_Integer, - -- Named numbers created by a number declaration with an integer value - - E_Named_Real, - -- Named numbers created by a number declaration with a real value - - ----------------------- - -- Enumeration Types -- - ----------------------- - - E_Enumeration_Type, - -- Enumeration types, created by an enumeration type declaration - - E_Enumeration_Subtype, - -- Enumeration subtypes, created by an explicit or implicit subtype - -- declaration applied to an enumeration type or subtype. - - ------------------- - -- Numeric Types -- - ------------------- - - E_Signed_Integer_Type, - -- Signed integer type, used for the anonymous base type of the - -- integer subtype created by an integer type declaration. - - E_Signed_Integer_Subtype, - -- Signed integer subtype, created by either an integer subtype or - -- integer type declaration (in the latter case an integer type is - -- created for the base type, and this is the first named subtype). - - E_Modular_Integer_Type, - -- Modular integer type, used for the anonymous base type of the - -- integer subtype created by a modular integer type declaration. - - E_Modular_Integer_Subtype, - -- Modular integer subtype, created by either an modular subtype - -- or modular type declaration (in the latter case a modular type - -- is created for the base type, and this is the first named subtype). - - E_Ordinary_Fixed_Point_Type, - -- Ordinary fixed type, used for the anonymous base type of the fixed - -- subtype created by an ordinary fixed point type declaration. - - E_Ordinary_Fixed_Point_Subtype, - -- Ordinary fixed point subtype, created by either an ordinary fixed - -- point subtype or ordinary fixed point type declaration (in the - -- latter case a fixed point type is created for the base type, and - -- this is the first named subtype). - - E_Decimal_Fixed_Point_Type, - -- Decimal fixed type, used for the anonymous base type of the decimal - -- fixed subtype created by an ordinary fixed point type declaration. - - E_Decimal_Fixed_Point_Subtype, - -- Decimal fixed point subtype, created by either a decimal fixed point - -- subtype or decimal fixed point type declaration (in the latter case - -- a fixed point type is created for the base type, and this is the - -- first named subtype). - - E_Floating_Point_Type, - -- Floating point type, used for the anonymous base type of the - -- floating point subtype created by a floating point type declaration. - - E_Floating_Point_Subtype, - - -- Floating point subtype, created by either a floating point subtype - -- or floating point type declaration (in the latter case a floating - -- point type is created for the base type, and this is the first - -- named subtype). - - ------------------ - -- Access Types -- - ------------------ - - E_Access_Type, - -- An access type created by an access type declaration with no all - -- keyword present. Note that the predefined type Any_Access, which - -- has E_Access_Type Ekind, is used to label NULL in the upwards pass - -- of type analysis, to be replaced by the true access type in the - -- downwards resolution pass. - - E_Access_Subtype, - -- An access subtype created by a subtype declaration for any access - -- type (whether or not it is a general access type). - - E_Access_Attribute_Type, - -- An access type created for an access attribute (one of 'Access, - -- 'Unrestricted_Access, or Unchecked_Access). - - E_Allocator_Type, - -- A special internal type used to label allocators and references to - -- objects using 'Reference. This is needed because special resolution - -- rules apply to these constructs. On the resolution pass, this type - -- is almost always replaced by the actual access type, but if the - -- context does not provide one, the backend will see Allocator_Type - -- itself (which will already have been frozen). - - E_General_Access_Type, - -- An access type created by an access type declaration with the all - -- keyword present. - - E_Access_Subprogram_Type, - -- An access-to-subprogram type, created by an access-to-subprogram - -- declaration. - - E_Access_Protected_Subprogram_Type, - -- An access to a protected subprogram, created by the corresponding - -- declaration. Values of such a type denote both a protected object - -- and a protected operation within, and have different compile-time - -- and run-time properties than other access-to-subprogram values. - - E_Anonymous_Access_Protected_Subprogram_Type, - -- An anonymous access-to-protected-subprogram type, created by an - -- access-to-subprogram declaration. - - E_Anonymous_Access_Subprogram_Type, - -- An anonymous access-to-subprogram type, created by an access-to- - -- subprogram declaration, or generated for a current instance of - -- a type name appearing within a component definition that has an - -- anonymous access-to-subprogram type. - - E_Anonymous_Access_Type, - -- An anonymous access type created by an access parameter or access - -- discriminant. - - --------------------- - -- Composite Types -- - --------------------- - - E_Array_Type, - -- An array type created by an array type declaration. Includes all - -- cases of arrays, except for string types. - - E_Array_Subtype, - -- An array subtype, created by an explicit array subtype declaration, - -- or the use of an anonymous array subtype. - - E_String_Literal_Subtype, - -- A special string subtype, used only to describe the type of a string - -- literal (will always be one dimensional, with literal bounds). - - E_Class_Wide_Type, - -- A class wide type, created by any tagged type declaration (i.e. if - -- a tagged type is declared, the corresponding class type is always - -- created, using this Ekind value). - - E_Class_Wide_Subtype, - -- A subtype of a class wide type, created by a subtype declaration - -- used to declare a subtype of a class type. - - E_Record_Type, - -- A record type, created by a record type declaration - - E_Record_Subtype, - -- A record subtype, created by a record subtype declaration - - E_Record_Type_With_Private, - -- Used for types defined by a private extension declaration, - -- and for tagged private types. Includes the fields for both - -- private types and for record types (with the sole exception of - -- Corresponding_Concurrent_Type which is obviously not needed). This - -- entity is considered to be both a record type and a private type. - - E_Record_Subtype_With_Private, - -- A subtype of a type defined by a private extension declaration - - E_Private_Type, - -- A private type, created by a private type declaration that has - -- neither the keyword limited nor the keyword tagged. - - E_Private_Subtype, - -- A subtype of a private type, created by a subtype declaration used - -- to declare a subtype of a private type. - - E_Limited_Private_Type, - -- A limited private type, created by a private type declaration that - -- has the keyword limited, but not the keyword tagged. - - E_Limited_Private_Subtype, - -- A subtype of a limited private type, created by a subtype declaration - -- used to declare a subtype of a limited private type. - - E_Incomplete_Type, - -- An incomplete type, created by an incomplete type declaration - - E_Incomplete_Subtype, - -- An incomplete subtype, created by a subtype declaration where the - -- subtype mark denotes an incomplete type. - - E_Task_Type, - -- A task type, created by a task type declaration. An entity with this - -- Ekind is also created to describe the anonymous type of a task that - -- is created by a single task declaration. - - E_Task_Subtype, - -- A subtype of a task type, created by a subtype declaration used to - -- declare a subtype of a task type. - - E_Protected_Type, - -- A protected type, created by a protected type declaration. An entity - -- with this Ekind is also created to describe the anonymous type of - -- a protected object created by a single protected declaration. - - E_Protected_Subtype, - -- A subtype of a protected type, created by a subtype declaration used - -- to declare a subtype of a protected type. - - ----------------- - -- Other Types -- - ----------------- - - E_Exception_Type, - -- The type of an exception created by an exception declaration - - E_Subprogram_Type, - -- This is the designated type of an Access_To_Subprogram. Has type and - -- signature like a subprogram entity, so can appear in calls, which - -- are resolved like regular calls, except that such an entity is not - -- overloadable. - - --------------------------- - -- Overloadable Entities -- - --------------------------- - - E_Enumeration_Literal, - -- An enumeration literal, created by the use of the literal in an - -- enumeration type definition. - - E_Function, - -- A function, created by a function declaration or a function body - -- that acts as its own declaration. - - E_Operator, - -- A predefined operator, appearing in Standard, or an implicitly - -- defined concatenation operator created whenever an array is declared. - -- We do not make normal derived operators explicit in the tree, but the - -- concatenation operators are made explicit. - - E_Procedure, - -- A procedure, created by a procedure declaration or a procedure - -- body that acts as its own declaration. - - E_Abstract_State, - -- A state abstraction. Used to designate entities introduced by aspect - -- or pragma Abstract_State. The entity carries the various properties - -- of the state. - - E_Entry, - -- An entry, created by an entry declaration in a task or protected - -- object. - - -------------------- - -- Other Entities -- - -------------------- - - E_Entry_Family, - -- An entry family, created by an entry family declaration in a - -- task or protected type definition. - - E_Block, - -- A block identifier, created by an explicit or implicit label on - -- a block or declare statement. - - E_Entry_Index_Parameter, - -- An entry index parameter created by an entry index specification - -- for the body of a protected entry family. - - E_Exception, - -- An exception created by an exception declaration. The exception - -- itself uses E_Exception for the Ekind, the implicit type that is - -- created to represent its type uses the Ekind E_Exception_Type. - - E_Generic_Function, - -- A generic function. This is the entity for a generic function - -- created by a generic subprogram declaration. - - E_Generic_Procedure, - -- A generic function. This is the entity for a generic procedure - -- created by a generic subprogram declaration. - - E_Generic_Package, - -- A generic package, this is the entity for a generic package created - -- by a generic package declaration. - - E_Label, - -- The defining entity for a label. Note that this is created by the - -- implicit label declaration, not the occurrence of the label itself, - -- which is simply a direct name referring to the label. - - E_Loop, - -- A loop identifier, created by an explicit or implicit label on a - -- loop statement. - - E_Return_Statement, - -- A dummy entity created for each return statement. Used to hold - -- information about the return statement (what it applies to) and in - -- rules checking. For example, a simple_return_statement that applies - -- to an extended_return_statement cannot have an expression; this - -- requires putting the E_Return_Statement entity for the - -- extended_return_statement on the scope stack. - - E_Package, - -- A package, created by a package declaration - - E_Package_Body, - -- A package body. This entity serves only limited functions, since - -- most semantic analysis uses the package entity (E_Package). However - -- there are some attributes that are significant for the body entity. - -- For example, collection of exception handlers. - - E_Protected_Body, - -- A protected body. This entity serves almost no function, since all - -- semantic analysis uses the protected entity (E_Protected_Type). - - E_Task_Body, - -- A task body. This entity serves almost no function, since all - -- semantic analysis uses the protected entity (E_Task_Type). - - E_Subprogram_Body - -- A subprogram body. Used when a subprogram has a separate declaration - -- to represent the entity for the body. This entity serves almost no - -- function, since all semantic analysis uses the subprogram entity - -- for the declaration (E_Function or E_Procedure). - ); - - for Entity_Kind'Size use 8; - -- The data structures in Atree assume this - - -------------------------- - -- Subtype Declarations -- - -------------------------- - - -- The above entities are arranged so that they can be conveniently grouped - -- into subtype ranges. Note that for each of the xxx_Kind ranges defined - -- below, there is a corresponding Is_xxx (or for types, Is_xxx_Type) - -- predicate which is to be used in preference to direct range tests using - -- the subtype name. However, the subtype names are available for direct - -- use, e.g. as choices in case statements. - - subtype Access_Kind is Entity_Kind range - E_Access_Type .. - -- E_Access_Subtype - -- E_Access_Attribute_Type - -- E_Allocator_Type - -- E_General_Access_Type - -- E_Access_Subprogram_Type - -- E_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Subprogram_Type - E_Anonymous_Access_Type; - - subtype Access_Subprogram_Kind is Entity_Kind range - E_Access_Subprogram_Type .. - -- E_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Protected_Subprogram_Type - E_Anonymous_Access_Subprogram_Type; - - subtype Access_Protected_Kind is Entity_Kind range - E_Access_Protected_Subprogram_Type .. - E_Anonymous_Access_Protected_Subprogram_Type; - - subtype Aggregate_Kind is Entity_Kind range - E_Array_Type .. - -- E_Array_Subtype - -- E_String_Literal_Subtype - -- E_Class_Wide_Type - -- E_Class_Wide_Subtype - -- E_Record_Type - E_Record_Subtype; - - subtype Anonymous_Access_Kind is Entity_Kind range - E_Anonymous_Access_Protected_Subprogram_Type .. - -- E_Anonymous_Subprogram_Type - E_Anonymous_Access_Type; - - subtype Array_Kind is Entity_Kind range - E_Array_Type .. - -- E_Array_Subtype - E_String_Literal_Subtype; - - subtype Assignable_Kind is Entity_Kind range - E_Variable .. - -- E_Out_Parameter - E_In_Out_Parameter; - - subtype Class_Wide_Kind is Entity_Kind range - E_Class_Wide_Type .. - E_Class_Wide_Subtype; - - subtype Composite_Kind is Entity_Kind range - E_Array_Type .. - -- E_Array_Subtype - -- E_String_Literal_Subtype - -- E_Class_Wide_Type - -- E_Class_Wide_Subtype - -- E_Record_Type - -- E_Record_Subtype - -- E_Record_Type_With_Private - -- E_Record_Subtype_With_Private - -- E_Private_Type - -- E_Private_Subtype - -- E_Limited_Private_Type - -- E_Limited_Private_Subtype - -- E_Incomplete_Type - -- E_Incomplete_Subtype - -- E_Task_Type - -- E_Task_Subtype, - -- E_Protected_Type, - E_Protected_Subtype; - - subtype Concurrent_Kind is Entity_Kind range - E_Task_Type .. - -- E_Task_Subtype, - -- E_Protected_Type, - E_Protected_Subtype; - - subtype Concurrent_Body_Kind is Entity_Kind range - E_Protected_Body .. - E_Task_Body; - - subtype Decimal_Fixed_Point_Kind is Entity_Kind range - E_Decimal_Fixed_Point_Type .. - E_Decimal_Fixed_Point_Subtype; - - subtype Digits_Kind is Entity_Kind range - E_Decimal_Fixed_Point_Type .. - -- E_Decimal_Fixed_Point_Subtype - -- E_Floating_Point_Type - E_Floating_Point_Subtype; - - subtype Discrete_Kind is Entity_Kind range - E_Enumeration_Type .. - -- E_Enumeration_Subtype - -- E_Signed_Integer_Type - -- E_Signed_Integer_Subtype - -- E_Modular_Integer_Type - E_Modular_Integer_Subtype; - - subtype Discrete_Or_Fixed_Point_Kind is Entity_Kind range - E_Enumeration_Type .. - -- E_Enumeration_Subtype - -- E_Signed_Integer_Type - -- E_Signed_Integer_Subtype - -- E_Modular_Integer_Type - -- E_Modular_Integer_Subtype - -- E_Ordinary_Fixed_Point_Type - -- E_Ordinary_Fixed_Point_Subtype - -- E_Decimal_Fixed_Point_Type - E_Decimal_Fixed_Point_Subtype; - - subtype Elementary_Kind is Entity_Kind range - E_Enumeration_Type .. - -- E_Enumeration_Subtype - -- E_Signed_Integer_Type - -- E_Signed_Integer_Subtype - -- E_Modular_Integer_Type - -- E_Modular_Integer_Subtype - -- E_Ordinary_Fixed_Point_Type - -- E_Ordinary_Fixed_Point_Subtype - -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Point_Subtype - -- E_Floating_Point_Type - -- E_Floating_Point_Subtype - -- E_Access_Type - -- E_Access_Subtype - -- E_Access_Attribute_Type - -- E_Allocator_Type - -- E_General_Access_Type - -- E_Access_Subprogram_Type - -- E_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Subprogram_Type - E_Anonymous_Access_Type; - - subtype Enumeration_Kind is Entity_Kind range - E_Enumeration_Type .. - E_Enumeration_Subtype; - - subtype Entry_Kind is Entity_Kind range - E_Entry .. - E_Entry_Family; - - subtype Fixed_Point_Kind is Entity_Kind range - E_Ordinary_Fixed_Point_Type .. - -- E_Ordinary_Fixed_Point_Subtype - -- E_Decimal_Fixed_Point_Type - E_Decimal_Fixed_Point_Subtype; - - subtype Float_Kind is Entity_Kind range - E_Floating_Point_Type .. - E_Floating_Point_Subtype; - - subtype Formal_Kind is Entity_Kind range - E_Out_Parameter .. - -- E_In_Out_Parameter - E_In_Parameter; - - subtype Formal_Object_Kind is Entity_Kind range - E_Generic_In_Out_Parameter .. - E_Generic_In_Parameter; - - subtype Generic_Subprogram_Kind is Entity_Kind range - E_Generic_Function .. - E_Generic_Procedure; - - subtype Generic_Unit_Kind is Entity_Kind range - E_Generic_Function .. - -- E_Generic_Procedure - E_Generic_Package; - - subtype Incomplete_Kind is Entity_Kind range - E_Incomplete_Type .. - E_Incomplete_Subtype; - - subtype Incomplete_Or_Private_Kind is Entity_Kind range - E_Record_Type_With_Private .. - -- E_Record_Subtype_With_Private - -- E_Private_Type - -- E_Private_Subtype - -- E_Limited_Private_Type - -- E_Limited_Private_Subtype - -- E_Incomplete_Type - E_Incomplete_Subtype; - - subtype Integer_Kind is Entity_Kind range - E_Signed_Integer_Type .. - -- E_Signed_Integer_Subtype - -- E_Modular_Integer_Type - E_Modular_Integer_Subtype; - - subtype Modular_Integer_Kind is Entity_Kind range - E_Modular_Integer_Type .. - E_Modular_Integer_Subtype; - - subtype Named_Kind is Entity_Kind range - E_Named_Integer .. - E_Named_Real; - - subtype Numeric_Kind is Entity_Kind range - E_Signed_Integer_Type .. - -- E_Signed_Integer_Subtype - -- E_Modular_Integer_Type - -- E_Modular_Integer_Subtype - -- E_Ordinary_Fixed_Point_Type - -- E_Ordinary_Fixed_Point_Subtype - -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Point_Subtype - -- E_Floating_Point_Type - E_Floating_Point_Subtype; - - subtype Object_Kind is Entity_Kind range - E_Component .. - -- E_Constant - -- E_Discriminant - -- E_Loop_Parameter - -- E_Variable - -- E_Out_Parameter - -- E_In_Out_Parameter - -- E_In_Parameter - -- E_Generic_In_Out_Parameter - E_Generic_In_Parameter; - - subtype Ordinary_Fixed_Point_Kind is Entity_Kind range - E_Ordinary_Fixed_Point_Type .. - E_Ordinary_Fixed_Point_Subtype; - - subtype Overloadable_Kind is Entity_Kind range - E_Enumeration_Literal .. - -- E_Function - -- E_Operator - -- E_Procedure - -- E_Abstract_State - E_Entry; - - subtype Private_Kind is Entity_Kind range - E_Record_Type_With_Private .. - -- E_Record_Subtype_With_Private - -- E_Private_Type - -- E_Private_Subtype - -- E_Limited_Private_Type - E_Limited_Private_Subtype; - - subtype Protected_Kind is Entity_Kind range - E_Protected_Type .. - E_Protected_Subtype; - - subtype Real_Kind is Entity_Kind range - E_Ordinary_Fixed_Point_Type .. - -- E_Ordinary_Fixed_Point_Subtype - -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Point_Subtype - -- E_Floating_Point_Type - E_Floating_Point_Subtype; - - subtype Record_Kind is Entity_Kind range - E_Class_Wide_Type .. - -- E_Class_Wide_Subtype - -- E_Record_Type - -- E_Record_Subtype - -- E_Record_Type_With_Private - E_Record_Subtype_With_Private; - - subtype Scalar_Kind is Entity_Kind range - E_Enumeration_Type .. - -- E_Enumeration_Subtype - -- E_Signed_Integer_Type - -- E_Signed_Integer_Subtype - -- E_Modular_Integer_Type - -- E_Modular_Integer_Subtype - -- E_Ordinary_Fixed_Point_Type - -- E_Ordinary_Fixed_Point_Subtype - -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Point_Subtype - -- E_Floating_Point_Type - E_Floating_Point_Subtype; - - subtype Subprogram_Kind is Entity_Kind range - E_Function .. - -- E_Operator - E_Procedure; - - subtype Signed_Integer_Kind is Entity_Kind range - E_Signed_Integer_Type .. - E_Signed_Integer_Subtype; - - subtype Task_Kind is Entity_Kind range - E_Task_Type .. - E_Task_Subtype; - - subtype Type_Kind is Entity_Kind range - E_Enumeration_Type .. - -- E_Enumeration_Subtype - -- E_Signed_Integer_Type - -- E_Signed_Integer_Subtype - -- E_Modular_Integer_Type - -- E_Modular_Integer_Subtype - -- E_Ordinary_Fixed_Point_Type - -- E_Ordinary_Fixed_Point_Subtype - -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Point_Subtype - -- E_Floating_Point_Type - -- E_Floating_Point_Subtype - -- E_Access_Type - -- E_Access_Subtype - -- E_Access_Attribute_Type - -- E_Allocator_Type, - -- E_General_Access_Type - -- E_Access_Subprogram_Type, - -- E_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Protected_Subprogram_Type - -- E_Anonymous_Access_Subprogram_Type - -- E_Anonymous_Access_Type - -- E_Array_Type - -- E_Array_Subtype - -- E_String_Literal_Subtype - -- E_Class_Wide_Subtype - -- E_Class_Wide_Type - -- E_Record_Type - -- E_Record_Subtype - -- E_Record_Type_With_Private - -- E_Record_Subtype_With_Private - -- E_Private_Type - -- E_Private_Subtype - -- E_Limited_Private_Type - -- E_Limited_Private_Subtype - -- E_Incomplete_Type - -- E_Incomplete_Subtype - -- E_Task_Type - -- E_Task_Subtype - -- E_Protected_Type - -- E_Protected_Subtype - -- E_Exception_Type - E_Subprogram_Type; +-- ????Some comments here should be retrieved -------------------------------------------------------- -- Description of Defined Attributes for Entity_Kinds -- @@ -5853,6 +5111,11 @@ package Einfo is -- Applicable attributes by entity kind -- ------------------------------------------ + -- In the conversion to variable-sized nodes and entities, which is an + -- ongoing project, a number of discrepancies were noticed. At least some + -- of these should be investigated at some point. They are documented in + -- comments, and marked with "$$$???". + -- E_Abstract_State -- Refinement_Constituents (Elist8) -- Part_Of_Constituents (Elist10) @@ -5864,6 +5127,7 @@ package Einfo is -- Has_Partial_Visible_Refinement (Flag296) -- Has_Visible_Refinement (Flag263) -- SPARK_Pragma_Inherited (Flag265) + -- First_Entity $$$??? -- Has_Non_Limited_View (synth) -- Has_Non_Null_Visible_Refinement (synth) -- Has_Null_Visible_Refinement (synth) @@ -5887,10 +5151,13 @@ package Einfo is -- Original_Access_Type (Node28) -- Can_Use_Internal_Rep (Flag229) -- Needs_Activation_Record (Flag306) + -- Associated_Storage_Pool $$$??? + -- Interface_Name $$$??? -- (plus type attributes) -- E_Access_Type -- E_Access_Subtype + -- Direct_Primitive_Operations $$$??? type -- Master_Id (Node17) -- Directly_Designated_Type (Node20) -- Associated_Storage_Pool (Node22) (base type only) @@ -5907,15 +5174,18 @@ package Einfo is -- (plus type attributes) -- E_Access_Attribute_Type + -- Renamed_Entity $$$??? -- Directly_Designated_Type (Node20) -- (plus type attributes) -- E_Allocator_Type -- Directly_Designated_Type (Node20) + -- Associated_Storage_Pool $$$??? -- (plus type attributes) -- E_Anonymous_Access_Subprogram_Type -- E_Anonymous_Access_Protected_Subprogram_Type + -- Interface_Name $$$??? E_Anonymous_Access_Subprogram_Type -- Directly_Designated_Type (Node20) -- Storage_Size_Variable (Node26) ??? is this needed ??? -- Can_Use_Internal_Rep (Flag229) @@ -5926,10 +5196,14 @@ package Einfo is -- Directly_Designated_Type (Node20) -- Finalization_Master (Node23) -- Storage_Size_Variable (Node26) ??? is this needed ??? + -- Associated_Storage_Pool $$$??? -- (plus type attributes) -- E_Array_Type -- E_Array_Subtype + -- First_Entity $$$??? + -- Direct_Primitive_Operations $$$??? subtype + -- Renamed_Object $$$??? E_Array_Subtype -- First_Index (Node17) -- Default_Aspect_Component_Value (Node19) (base type only) -- Component_Type (Node20) (base type only) @@ -5950,6 +5224,8 @@ package Einfo is -- (plus type attributes) -- E_Block + -- Renamed_Entity $$$??? + -- Renamed_Object $$$??? -- Return_Applies_To (Node8) -- Block_Node (Node11) -- First_Entity (Node17) @@ -5976,12 +5252,15 @@ package Einfo is -- Last_Entity (Node20) -- SSO_Set_High_By_Default (Flag273) (base type only) -- SSO_Set_Low_By_Default (Flag272) (base type only) + -- Corresponding_Remote_Type $$$??? type + -- Renamed_Entity $$$??? type -- First_Component (synth) -- First_Component_Or_Discriminant (synth) -- Has_Non_Limited_View (synth) -- (plus type attributes) -- E_Component + -- Linker_Section_Pragma $$$??? -- Normalized_First_Bit (Uint8) -- Current_Value (Node9) (always Empty) -- Normalized_Position_Max (Uint10) @@ -6022,6 +5301,7 @@ package Einfo is -- Status_Flag_Or_Transient_Decl (Node15) -- Actual_Subtype (Node17) -- Renamed_Object (Node18) + -- Renamed_Entity $$$??? -- Size_Check_Code (Node19) (constants only) -- Prival_Link (Node20) (privals only) -- Interface_Name (Node21) (constants only) @@ -6066,7 +5346,7 @@ package Einfo is -- Size_Clause (synth) -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Subtype + -- E_Decimal_Fixed_Subtype$$$???no such thing -- Scale_Value (Uint16) -- Digits_Value (Uint17) -- Scalar_Range (Node20) @@ -6098,6 +5378,8 @@ package Einfo is -- CR_Discriminant (Node23) -- Is_Completely_Hidden (Flag103) -- Is_Return_Object (Flag209) + -- Entry_Formal $$$??? + -- Linker_Section_Pragma $$$??? -- Next_Component_Or_Discriminant (synth) -- Next_Discriminant (synth) -- Next_Stored_Discriminant (synth) @@ -6131,6 +5413,7 @@ package Einfo is -- Sec_Stack_Needed_For_Return (Flag167) -- SPARK_Pragma_Inherited (Flag265) (protected kind) -- Uses_Sec_Stack (Flag95) + -- Renamed_Entity $$$??? -- Address_Clause (synth) -- Entry_Index_Type (synth) -- First_Formal (synth) @@ -6148,10 +5431,16 @@ package Einfo is -- Enumeration_Rep (Uint12) -- Alias (Node18) -- Enumeration_Rep_Expr (Node22) + -- Interface_Name $$$??? + -- Renamed_Object $$$??? + -- Esize $$$??? + -- Renamed_Entity $$$??? -- Next_Literal (synth) -- E_Enumeration_Type -- E_Enumeration_Subtype + -- First_Entity $$$??? type + -- Renamed_Object $$$??? -- Lit_Strings (Node16) (root type only) -- First_Literal (Node17) -- Lit_Indexes (Node18) (root type only) @@ -6180,6 +5469,7 @@ package Einfo is -- Activation_Record_Component (Node31) -- Discard_Names (Flag88) -- Is_Raised (Flag224) + -- Renamed_Object $$$??? -- E_Exception_Type -- Equivalent_Type (Node18) @@ -6221,12 +5511,14 @@ package Einfo is -- First_Entity (Node17) -- Alias (Node18) (non-generic case only) -- Renamed_Entity (Node18) + -- Renamed_Object $$$??? -- Extra_Accessibility_Of_Result (Node19) (non-generic case only) -- Last_Entity (Node20) -- Interface_Name (Node21) -- Scope_Depth_Value (Uint22) -- Generic_Renamings (Elist23) (for an instance) -- Inner_Instances (Elist23) (generic case only) + -- Inner_Instances $$$??? also E_Function -- Protection_Object (Node23) (for concurrent kind) -- Subps_Index (Uint24) (non-generic case only) -- Interface_Alias (Node25) @@ -6306,6 +5598,8 @@ package Einfo is -- Scope_Depth (synth) -- E_General_Access_Type + -- First_Entity $$$??? + -- Renamed_Entity $$$??? -- Master_Id (Node17) -- Directly_Designated_Type (Node20) -- Associated_Storage_Pool (Node22) (root type only) @@ -6332,12 +5626,15 @@ package Einfo is -- Private_Dependents (Elist18) -- Discriminant_Constraint (Elist21) -- Stored_Constraint (Elist23) + -- First_Entity $$$??? + -- Last_Entity $$$??? -- Has_Non_Limited_View (synth) -- (plus type attributes) -- E_In_Parameter -- E_In_Out_Parameter -- E_Out_Parameter + -- Linker_Section_Pragma $$$??? -- Mechanism (Uint8) (Mechanism_Type) -- Current_Value (Node9) -- Discriminal_Link (Node10) (discriminals only) @@ -6366,11 +5663,14 @@ package Einfo is -- Parameter_Mode (synth) -- E_Label + -- Renamed_Object $$$??? + -- Renamed_Entity $$$??? -- Enclosing_Scope (Node18) -- Reachable (Flag49) -- E_Limited_Private_Type -- E_Limited_Private_Subtype + -- Scalar_Range $$$??? type -- First_Entity (Node17) -- Private_Dependents (Elist18) -- Underlying_Full_View (Node19) @@ -6387,6 +5687,9 @@ package Einfo is -- Has_Master_Entity (Flag21) -- Has_Nested_Block_With_Handler (Flag101) -- Uses_Sec_Stack (Flag95) + -- First_Entity $$$??? + -- Last_Entity $$$??? + -- Renamed_Object $$$??? -- E_Modular_Integer_Type -- E_Modular_Integer_Subtype @@ -6405,6 +5708,7 @@ package Einfo is -- (plus type attributes) -- E_Named_Integer + -- Renamed_Object $$$??? -- E_Named_Real @@ -6429,6 +5733,9 @@ package Einfo is -- Is_Primitive (Flag218) -- Is_Pure (Flag44) -- SPARK_Pragma_Inherited (Flag265) + -- Interface_Name $$$??? + -- Renamed_Entity $$$??? + -- Renamed_Object $$$??? -- Is_Elaboration_Target (synth) -- Aren't there more flags and fields? seems like this list should be -- more similar to the E_Function list, which is much longer ??? @@ -6458,12 +5765,14 @@ package Einfo is -- First_Private_Entity (Node16) -- First_Entity (Node17) -- Renamed_Entity (Node18) + -- Renamed_Object $$$??? -- Body_Entity (Node19) -- Last_Entity (Node20) -- Interface_Name (Node21) -- Scope_Depth_Value (Uint22) -- Generic_Renamings (Elist23) (for an instance) -- Inner_Instances (Elist23) (generic case only) + -- Inner_Instances $$$??? also E_Package -- Limited_View (Node23) (non-generic/instance) -- Incomplete_Actuals (Elist24) (for an instance) -- Abstract_States (Elist25) @@ -6500,6 +5809,7 @@ package Einfo is -- SPARK_Aux_Pragma_Inherited (Flag266) -- SPARK_Pragma_Inherited (Flag265) -- Static_Elaboration_Desired (Flag77) (non-generic case only) + -- Renamed_Object $$$??? -- Has_Non_Null_Abstract_State (synth) -- Has_Null_Abstract_State (synth) -- Is_Elaboration_Target (synth) @@ -6523,10 +5833,12 @@ package Einfo is -- Ignore_SPARK_Mode_Pragmas (Flag301) -- SPARK_Aux_Pragma_Inherited (Flag266) -- SPARK_Pragma_Inherited (Flag265) + -- Renamed_Entity $$$??? -- Scope_Depth (synth) -- E_Private_Type -- E_Private_Subtype + -- Scalar_Range $$$??? type -- Direct_Primitive_Operations (Elist10) -- First_Entity (Node17) -- Private_Dependents (Elist18) @@ -6536,10 +5848,12 @@ package Einfo is -- Stored_Constraint (Elist23) -- Has_Completion (Flag26) -- Is_Controlled_Active (Flag42) (base type only) + -- $$$???above in (plus type attributes) -- (plus type attributes) -- E_Procedure -- E_Generic_Procedure + -- Associated_Node_For_Itype $$$??? E_Procedure -- Renaming_Map (Uint9) -- Handler_Records (List10) (non-generic case only) -- Protected_Body_Subprogram (Node11) @@ -6551,12 +5865,14 @@ package Einfo is -- First_Entity (Node17) -- Alias (Node18) (non-generic case only) -- Renamed_Entity (Node18) + -- Renamed_Object $$$??? -- Receiving_Entry (Node19) (non-generic case only) -- Last_Entity (Node20) -- Interface_Name (Node21) -- Scope_Depth_Value (Uint22) -- Generic_Renamings (Elist23) (for an instance) -- Inner_Instances (Elist23) (generic case only) + -- Inner_Instances $$$??? also E_Procedure -- Protection_Object (Node23) (for concurrent kind) -- Subps_Index (Uint24) (non-generic case only) -- Interface_Alias (Node25) @@ -6576,8 +5892,8 @@ package Einfo is -- Original_Protected_Subprogram (Node41) -- Body_Needed_For_SAL (Flag40) -- Contains_Ignored_Ghost_Code (Flag279) - -- Delay_Cleanups (Flag114) - -- Discard_Names (Flag88) + -- Delay_Cleanups (Flag114)$$$???Dup below + -- Discard_Names (Flag88)$$$???Dup below -- Elaboration_Entity_Required (Flag174) -- Default_Expressions_Processed (Flag108) -- Delay_Cleanups (Flag114) @@ -6625,6 +5941,7 @@ package Einfo is -- Requires_Overriding (Flag213) (non-generic case only) -- Sec_Stack_Needed_For_Return (Flag167) -- SPARK_Pragma_Inherited (Flag265) + -- Entry_Parameters_Type $$$??? -- Address_Clause (synth) -- First_Formal (synth) -- First_Formal_With_Extras (synth) @@ -6639,7 +5956,7 @@ package Einfo is -- SPARK_Pragma_Inherited (Flag265) -- (any others??? First/Last Entity, Scope_Depth???) - -- E_Protected_Object + -- E_Protected_Object$$$???No such thing -- E_Protected_Type -- E_Protected_Subtype @@ -6669,6 +5986,8 @@ package Einfo is -- E_Record_Type -- E_Record_Subtype + -- Renamed_Entity $$$??? type + -- Interface_Name $$$??? type -- Direct_Primitive_Operations (Elist10) -- Access_Disp_Table (Elist16) (base type only) -- Cloned_Subtype (Node16) (subtype case only) @@ -6696,6 +6015,7 @@ package Einfo is -- Is_Concurrent_Record_Type (Flag20) -- Is_Constrained (Flag12) -- Is_Controlled_Active (Flag42) (base type only) + -- $$$???above in (plus type attributes) -- Is_Interface (Flag186) -- Is_Limited_Interface (Flag197) -- No_Reordering (Flag239) (base type only) @@ -6709,6 +6029,7 @@ package Einfo is -- E_Record_Type_With_Private -- E_Record_Subtype_With_Private + -- Corresponding_Remote_Type $$$??? E_Record_Subtype_With_Private -- Direct_Primitive_Operations (Elist10) -- First_Entity (Node17) -- Private_Dependents (Elist18) @@ -6717,6 +6038,7 @@ package Einfo is -- Discriminant_Constraint (Elist21) -- Stored_Constraint (Elist23) -- Interfaces (Elist25) + -- Underlying_Record_View $$$??? (Node28) (base type only) -- Predicated_Parent (Node38) (subtype only) -- Has_Completion (Flag26) -- Has_Private_Ancestor (Flag151) @@ -6725,6 +6047,7 @@ package Einfo is -- Is_Concurrent_Record_Type (Flag20) -- Is_Constrained (Flag12) -- Is_Controlled_Active (Flag42) (base type only) + -- $$$???above in (plus type attributes) -- Is_Interface (Flag186) -- Is_Limited_Interface (Flag197) -- No_Reordering (Flag239) (base type only) @@ -6732,15 +6055,22 @@ package Einfo is -- Reverse_Storage_Order (Flag93) (base type only) -- SSO_Set_High_By_Default (Flag273) (base type only) -- SSO_Set_Low_By_Default (Flag272) (base type only) + -- Corresponding_Remote_Type $$$??? type -- First_Component (synth) -- First_Component_Or_Discriminant (synth) -- (plus type attributes) -- E_Return_Statement -- Return_Applies_To (Node8) + -- First_Entity $$$??? + -- Last_Entity $$$??? -- E_Signed_Integer_Type -- E_Signed_Integer_Subtype + -- Renamed_Object $$$??? subtype + -- Interface_Name $$$??? subtype + -- Direct_Primitive_Operations $$$??? type + -- First_Entity $$$??? -- Default_Aspect_Value (Node19) (base type only) -- Scalar_Range (Node20) -- Static_Discrete_Predicate (List25) @@ -6771,6 +6101,8 @@ package Einfo is -- SPARK_Pragma (Node40) -- Contains_Ignored_Ghost_Code (Flag279) -- SPARK_Pragma_Inherited (Flag265) + -- Interface_Name $$$??? + -- Renamed_Entity $$$??? -- Scope_Depth (synth) -- E_Subprogram_Type @@ -6783,6 +6115,9 @@ package Einfo is -- Last_Formal (synth) -- Number_Formals (synth) -- Returns_By_Ref (Flag90) + -- First_Entity $$$??? + -- Last_Entity $$$??? + -- Interface_Name $$$??? -- (plus type attributes) -- E_Task_Body @@ -6790,6 +6125,7 @@ package Einfo is -- SPARK_Pragma (Node40) -- Ignore_SPARK_Mode_Pragmas (Flag301) -- SPARK_Pragma_Inherited (Flag265) + -- First_Entity $$$??? -- (any others??? First/Last Entity, Scope_Depth???) -- E_Task_Type @@ -6835,6 +6171,8 @@ package Einfo is -- Unset_Reference (Node16) -- Actual_Subtype (Node17) -- Renamed_Object (Node18) + -- Renamed_Entity $$$??? + -- Discriminal_Link $$$??? -- Size_Check_Code (Node19) -- Prival_Link (Node20) -- Interface_Name (Node21) @@ -6901,30 +6239,25 @@ package Einfo is -- value will be appropriate for the attributes set, and the consequence -- is that the dynamic type checking in the Einfo body is unnecessarily -- weak. To be looked at systematically some time ??? - - --------------------------------- - -- Component_Alignment Control -- - --------------------------------- - - -- There are four types of alignment possible for array and record - -- types, and a field in the type entities contains a value of the - -- following type indicating which alignment choice applies. For full - -- details of the meaning of these alignment types, see description - -- of the Component_Alignment pragma. - - type Component_Alignment_Kind is ( - Calign_Default, -- default alignment - Calign_Component_Size, -- natural alignment for component size - Calign_Component_Size_4, -- natural for size <= 4, 4 for size >= 4 - Calign_Storage_Unit); -- all components byte aligned - - ----------------------------------- - -- Floating Point Representation -- - ----------------------------------- - - type Float_Rep_Kind is ( - IEEE_Binary, -- IEEE 754p conforming binary format - AAMP); -- AAMP format + -- + -- ???Following are examples of getters and setters called with E_Void: + -- Entry_Formal $$$??? + -- Esize $$$??? + -- First_Entity $$$??? + -- Handler_Records $$$??? + -- Interface_Name $$$??? + -- Last_Entity $$$??? + -- Renamed_Entity $$$??? + -- Renamed_Object $$$??? + -- Scalar_Range $$$??? + -- Set_Associated_Node_For_Itype $$$??? + -- Set_Debug_Renaming_Link $$$??? + -- Set_Entry_Cancel_Parameter $$$??? + -- Set_First_Entity $$$??? + -- Set_Inner_Instances $$$??? + -- Set_Last_Entity $$$??? + -- Set_Scalar_Range $$$??? + -- Set_Entry_Cancel_Parameter $$$??? --------------- -- Iterators -- @@ -7093,1579 +6426,6 @@ package Einfo is -- example), the expansion mechanism uses the placeholder of the component -- to correct the Entity and Etype of the reference. - ------------------- - -- Type Synonyms -- - ------------------- - - -- The following type synonyms are used to tidy up the function and - -- procedure declarations that follow, and also to make it possible to meet - -- the requirement for the XEINFO utility that all function specs must fit - -- on a single source line. - - subtype B is Boolean; - subtype C is Component_Alignment_Kind; - subtype E is Entity_Id; - subtype F is Float_Rep_Kind; - subtype M is Mechanism_Type; - subtype N is Node_Id; - subtype U is Uint; - subtype R is Ureal; - subtype L is Elist_Id; - subtype S is List_Id; - - -------------------------------- - -- Attribute Access Functions -- - -------------------------------- - - -- All attributes are manipulated through a procedural interface. This - -- section contains the functions used to obtain attribute values which - -- correspond to values in fields or flags in the entity itself. - - function Abstract_States (Id : E) return L; - function Accept_Address (Id : E) return L; - function Access_Disp_Table (Id : E) return L; - function Access_Disp_Table_Elab_Flag (Id : E) return E; - function Access_Subprogram_Wrapper (Id : E) return E; - function Activation_Record_Component (Id : E) return E; - function Actual_Subtype (Id : E) return E; - function Address_Taken (Id : E) return B; - function Alias (Id : E) return E; - function Alignment (Id : E) return U; - function Anonymous_Designated_Type (Id : E) return E; - function Anonymous_Masters (Id : E) return L; - function Anonymous_Object (Id : E) return E; - function Associated_Entity (Id : E) return E; - function Associated_Formal_Package (Id : E) return E; - function Associated_Node_For_Itype (Id : E) return N; - function Associated_Storage_Pool (Id : E) return E; - function Barrier_Function (Id : E) return N; - function BIP_Initialization_Call (Id : E) return N; - function Block_Node (Id : E) return N; - function Body_Entity (Id : E) return E; - function Body_Needed_For_SAL (Id : E) return B; - function Body_Needed_For_Inlining (Id : E) return B; - function Body_References (Id : E) return L; - function C_Pass_By_Copy (Id : E) return B; - function Can_Never_Be_Null (Id : E) return B; - function Can_Use_Internal_Rep (Id : E) return B; - function Checks_May_Be_Suppressed (Id : E) return B; - function Class_Wide_Clone (Id : E) return E; - function Class_Wide_Type (Id : E) return E; - function Cloned_Subtype (Id : E) return E; - function Component_Bit_Offset (Id : E) return U; - function Component_Clause (Id : E) return N; - function Component_Size (Id : E) return U; - function Component_Type (Id : E) return E; - function Contains_Ignored_Ghost_Code (Id : E) return B; - function Contract (Id : E) return N; - function Contract_Wrapper (Id : E) return E; - function Corresponding_Concurrent_Type (Id : E) return E; - function Corresponding_Discriminant (Id : E) return E; - function Corresponding_Equality (Id : E) return E; - function Corresponding_Function (Id : E) return E; - function Corresponding_Procedure (Id : E) return E; - function Corresponding_Protected_Entry (Id : E) return E; - function Corresponding_Record_Component (Id : E) return E; - function Corresponding_Record_Type (Id : E) return E; - function Corresponding_Remote_Type (Id : E) return E; - function CR_Discriminant (Id : E) return E; - function Current_Use_Clause (Id : E) return E; - function Current_Value (Id : E) return N; - function Debug_Info_Off (Id : E) return B; - function Debug_Renaming_Link (Id : E) return E; - function Default_Aspect_Component_Value (Id : E) return N; - function Default_Aspect_Value (Id : E) return N; - function Default_Expr_Function (Id : E) return E; - function Default_Expressions_Processed (Id : E) return B; - function Default_Value (Id : E) return N; - function Delay_Cleanups (Id : E) return B; - function Delay_Subprogram_Descriptors (Id : E) return B; - function Delta_Value (Id : E) return R; - function Dependent_Instances (Id : E) return L; - function Depends_On_Private (Id : E) return B; - function Derived_Type_Link (Id : E) return E; - function Digits_Value (Id : E) return U; - function Direct_Primitive_Operations (Id : E) return L; - function Directly_Designated_Type (Id : E) return E; - function Disable_Controlled (Id : E) return B; - function Discard_Names (Id : E) return B; - function Discriminal (Id : E) return E; - function Discriminal_Link (Id : E) return E; - function Discriminant_Checking_Func (Id : E) return E; - function Discriminant_Constraint (Id : E) return L; - function Discriminant_Default_Value (Id : E) return N; - function Discriminant_Number (Id : E) return U; - function Dispatch_Table_Wrappers (Id : E) return L; - function DT_Entry_Count (Id : E) return U; - function DT_Offset_To_Top_Func (Id : E) return E; - function DT_Position (Id : E) return U; - function DTC_Entity (Id : E) return E; - function Elaborate_Body_Desirable (Id : E) return B; - function Elaboration_Entity (Id : E) return E; - function Elaboration_Entity_Required (Id : E) return B; - function Encapsulating_State (Id : E) return E; - function Enclosing_Scope (Id : E) return E; - function Entry_Accepted (Id : E) return B; - function Entry_Bodies_Array (Id : E) return E; - function Entry_Cancel_Parameter (Id : E) return E; - function Entry_Component (Id : E) return E; - function Entry_Formal (Id : E) return E; - function Entry_Index_Constant (Id : E) return E; - function Entry_Index_Type (Id : E) return E; - function Entry_Max_Queue_Lengths_Array (Id : E) return E; - function Entry_Parameters_Type (Id : E) return E; - function Enum_Pos_To_Rep (Id : E) return E; - function Enumeration_Pos (Id : E) return U; - function Enumeration_Rep (Id : E) return U; - function Enumeration_Rep_Expr (Id : E) return N; - function Equivalent_Type (Id : E) return E; - function Esize (Id : E) return U; - function Extra_Accessibility (Id : E) return E; - function Extra_Accessibility_Of_Result (Id : E) return E; - function Extra_Constrained (Id : E) return E; - function Extra_Formal (Id : E) return E; - function Extra_Formals (Id : E) return E; - function Finalization_Master (Id : E) return E; - function Finalize_Storage_Only (Id : E) return B; - function Finalizer (Id : E) return E; - function First_Entity (Id : E) return E; - function First_Exit_Statement (Id : E) return N; - function First_Index (Id : E) return N; - function First_Literal (Id : E) return E; - function First_Private_Entity (Id : E) return E; - function First_Rep_Item (Id : E) return N; - function Float_Rep (Id : E) return F; - function Freeze_Node (Id : E) return N; - function From_Limited_With (Id : E) return B; - function Full_View (Id : E) return E; - function Generic_Homonym (Id : E) return E; - function Generic_Renamings (Id : E) return L; - function Handler_Records (Id : E) return S; - function Has_Aliased_Components (Id : E) return B; - function Has_Alignment_Clause (Id : E) return B; - function Has_All_Calls_Remote (Id : E) return B; - function Has_Atomic_Components (Id : E) return B; - function Has_Biased_Representation (Id : E) return B; - function Has_Completion (Id : E) return B; - function Has_Completion_In_Body (Id : E) return B; - function Has_Complex_Representation (Id : E) return B; - function Has_Component_Size_Clause (Id : E) return B; - function Has_Constrained_Partial_View (Id : E) return B; - function Has_Contiguous_Rep (Id : E) return B; - function Has_Controlled_Component (Id : E) return B; - function Has_Controlling_Result (Id : E) return B; - function Has_Convention_Pragma (Id : E) return B; - function Has_Default_Aspect (Id : E) return B; - function Has_Delayed_Aspects (Id : E) return B; - function Has_Delayed_Freeze (Id : E) return B; - function Has_Delayed_Rep_Aspects (Id : E) return B; - function Has_Discriminants (Id : E) return B; - function Has_Dispatch_Table (Id : E) return B; - function Has_Dynamic_Predicate_Aspect (Id : E) return B; - function Has_Enumeration_Rep_Clause (Id : E) return B; - function Has_Exit (Id : E) return B; - function Has_Expanded_Contract (Id : E) return B; - function Has_Forward_Instantiation (Id : E) return B; - function Has_Fully_Qualified_Name (Id : E) return B; - function Has_Gigi_Rep_Item (Id : E) return B; - function Has_Homonym (Id : E) return B; - function Has_Implicit_Dereference (Id : E) return B; - function Has_Independent_Components (Id : E) return B; - function Has_Inheritable_Invariants (Id : E) return B; - function Has_Inherited_DIC (Id : E) return B; - function Has_Inherited_Invariants (Id : E) return B; - function Has_Initial_Value (Id : E) return B; - function Has_Loop_Entry_Attributes (Id : E) return B; - function Has_Machine_Radix_Clause (Id : E) return B; - function Has_Master_Entity (Id : E) return B; - function Has_Missing_Return (Id : E) return B; - function Has_Nested_Block_With_Handler (Id : E) return B; - function Has_Nested_Subprogram (Id : E) return B; - function Has_Non_Standard_Rep (Id : E) return B; - function Has_Object_Size_Clause (Id : E) return B; - function Has_Out_Or_In_Out_Parameter (Id : E) return B; - function Has_Own_DIC (Id : E) return B; - function Has_Own_Invariants (Id : E) return B; - function Has_Partial_Visible_Refinement (Id : E) return B; - function Has_Per_Object_Constraint (Id : E) return B; - function Has_Pragma_Controlled (Id : E) return B; - function Has_Pragma_Elaborate_Body (Id : E) return B; - function Has_Pragma_Inline (Id : E) return B; - function Has_Pragma_Inline_Always (Id : E) return B; - function Has_Pragma_No_Inline (Id : E) return B; - function Has_Pragma_Ordered (Id : E) return B; - function Has_Pragma_Pack (Id : E) return B; - function Has_Pragma_Preelab_Init (Id : E) return B; - function Has_Pragma_Pure (Id : E) return B; - function Has_Pragma_Pure_Function (Id : E) return B; - function Has_Pragma_Thread_Local_Storage (Id : E) return B; - function Has_Pragma_Unmodified (Id : E) return B; - function Has_Pragma_Unreferenced (Id : E) return B; - function Has_Pragma_Unreferenced_Objects (Id : E) return B; - function Has_Pragma_Unused (Id : E) return B; - function Has_Predicates (Id : E) return B; - function Has_Primitive_Operations (Id : E) return B; - function Has_Private_Ancestor (Id : E) return B; - function Has_Private_Declaration (Id : E) return B; - function Has_Private_Extension (Id : E) return B; - function Has_Protected (Id : E) return B; - function Has_Qualified_Name (Id : E) return B; - function Has_RACW (Id : E) return B; - function Has_Record_Rep_Clause (Id : E) return B; - function Has_Recursive_Call (Id : E) return B; - function Has_Shift_Operator (Id : E) return B; - function Has_Size_Clause (Id : E) return B; - function Has_Small_Clause (Id : E) return B; - function Has_Specified_Layout (Id : E) return B; - function Has_Specified_Stream_Input (Id : E) return B; - function Has_Specified_Stream_Output (Id : E) return B; - function Has_Specified_Stream_Read (Id : E) return B; - function Has_Specified_Stream_Write (Id : E) return B; - function Has_Static_Discriminants (Id : E) return B; - function Has_Static_Predicate (Id : E) return B; - function Has_Static_Predicate_Aspect (Id : E) return B; - function Has_Storage_Size_Clause (Id : E) return B; - function Has_Stream_Size_Clause (Id : E) return B; - function Has_Task (Id : E) return B; - function Has_Timing_Event (Id : E) return B; - function Has_Thunks (Id : E) return B; - function Has_Unchecked_Union (Id : E) return B; - function Has_Unknown_Discriminants (Id : E) return B; - function Has_Visible_Refinement (Id : E) return B; - function Has_Volatile_Components (Id : E) return B; - function Has_Xref_Entry (Id : E) return B; - function Has_Yield_Aspect (Id : E) return B; - function Hiding_Loop_Variable (Id : E) return E; - function Hidden_In_Formal_Instance (Id : E) return L; - function Homonym (Id : E) return E; - function Ignore_SPARK_Mode_Pragmas (Id : E) return B; - function Import_Pragma (Id : E) return E; - function Incomplete_Actuals (Id : E) return L; - function In_Package_Body (Id : E) return B; - function In_Private_Part (Id : E) return B; - function In_Use (Id : E) return B; - function Initialization_Statements (Id : E) return N; - function Inner_Instances (Id : E) return L; - function Interface_Alias (Id : E) return E; - function Interface_Name (Id : E) return N; - function Interfaces (Id : E) return L; - function Is_Abstract_Subprogram (Id : E) return B; - function Is_Abstract_Type (Id : E) return B; - function Is_Access_Constant (Id : E) return B; - function Is_Activation_Record (Id : E) return B; - function Is_Actual_Subtype (Id : E) return B; - function Is_Ada_2005_Only (Id : E) return B; - function Is_Ada_2012_Only (Id : E) return B; - function Is_Aliased (Id : E) return B; - function Is_Asynchronous (Id : E) return B; - function Is_Atomic (Id : E) return B; - function Is_Bit_Packed_Array (Id : E) return B; - function Is_Called (Id : E) return B; - function Is_Character_Type (Id : E) return B; - function Is_Checked_Ghost_Entity (Id : E) return B; - function Is_Child_Unit (Id : E) return B; - function Is_Class_Wide_Clone (Id : E) return B; - function Is_Class_Wide_Equivalent_Type (Id : E) return B; - function Is_Compilation_Unit (Id : E) return B; - function Is_Completely_Hidden (Id : E) return B; - function Is_Constr_Subt_For_U_Nominal (Id : E) return B; - function Is_Constr_Subt_For_UN_Aliased (Id : E) return B; - function Is_Constrained (Id : E) return B; - function Is_Constructor (Id : E) return B; - function Is_Controlled_Active (Id : E) return B; - function Is_Controlling_Formal (Id : E) return B; - function Is_CPP_Class (Id : E) return B; - function Is_CUDA_Kernel (Id : E) return B; - function Is_Descendant_Of_Address (Id : E) return B; - function Is_DIC_Procedure (Id : E) return B; - function Is_Discrim_SO_Function (Id : E) return B; - function Is_Discriminant_Check_Function (Id : E) return B; - function Is_Dispatch_Table_Entity (Id : E) return B; - function Is_Dispatching_Operation (Id : E) return B; - function Is_Elaboration_Checks_OK_Id (Id : E) return B; - function Is_Elaboration_Warnings_OK_Id (Id : E) return B; - function Is_Eliminated (Id : E) return B; - function Is_Entry_Formal (Id : E) return B; - function Is_Entry_Wrapper (Id : E) return B; - function Is_Exception_Handler (Id : E) return B; - function Is_Exported (Id : E) return B; - function Is_Finalized_Transient (Id : E) return B; - function Is_First_Subtype (Id : E) return B; - function Is_Frozen (Id : E) return B; - function Is_Generic_Instance (Id : E) return B; - function Is_Hidden (Id : E) return B; - function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B; - function Is_Hidden_Open_Scope (Id : E) return B; - function Is_Ignored_Ghost_Entity (Id : E) return B; - function Is_Ignored_Transient (Id : E) return B; - function Is_Immediately_Visible (Id : E) return B; - function Is_Implementation_Defined (Id : E) return B; - function Is_Imported (Id : E) return B; - function Is_Independent (Id : E) return B; - function Is_Initial_Condition_Procedure (Id : E) return B; - function Is_Inlined (Id : E) return B; - function Is_Inlined_Always (Id : E) return B; - function Is_Instantiated (Id : E) return B; - function Is_Interface (Id : E) return B; - function Is_Internal (Id : E) return B; - function Is_Interrupt_Handler (Id : E) return B; - function Is_Intrinsic_Subprogram (Id : E) return B; - function Is_Invariant_Procedure (Id : E) return B; - function Is_Itype (Id : E) return B; - function Is_Known_Non_Null (Id : E) return B; - function Is_Known_Null (Id : E) return B; - function Is_Known_Valid (Id : E) return B; - function Is_Limited_Composite (Id : E) return B; - function Is_Limited_Interface (Id : E) return B; - function Is_Local_Anonymous_Access (Id : E) return B; - function Is_Loop_Parameter (Id : E) return B; - function Is_Machine_Code_Subprogram (Id : E) return B; - function Is_Non_Static_Subtype (Id : E) return B; - function Is_Null_Init_Proc (Id : E) return B; - function Is_Obsolescent (Id : E) return B; - function Is_Only_Out_Parameter (Id : E) return B; - function Is_Package_Body_Entity (Id : E) return B; - function Is_Packed (Id : E) return B; - function Is_Packed_Array_Impl_Type (Id : E) return B; - function Is_Potentially_Use_Visible (Id : E) return B; - function Is_Param_Block_Component_Type (Id : E) return B; - function Is_Partial_DIC_Procedure (Id : E) return B; - function Is_Partial_Invariant_Procedure (Id : E) return B; - function Is_Predicate_Function (Id : E) return B; - function Is_Predicate_Function_M (Id : E) return B; - function Is_Preelaborated (Id : E) return B; - function Is_Primitive (Id : E) return B; - function Is_Primitive_Wrapper (Id : E) return B; - function Is_Private_Composite (Id : E) return B; - function Is_Private_Descendant (Id : E) return B; - function Is_Private_Primitive (Id : E) return B; - function Is_Public (Id : E) return B; - function Is_Pure (Id : E) return B; - function Is_Pure_Unit_Access_Type (Id : E) return B; - function Is_RACW_Stub_Type (Id : E) return B; - function Is_Raised (Id : E) return B; - function Is_Remote_Call_Interface (Id : E) return B; - function Is_Remote_Types (Id : E) return B; - function Is_Renaming_Of_Object (Id : E) return B; - function Is_Return_Object (Id : E) return B; - function Is_Safe_To_Reevaluate (Id : E) return B; - function Is_Shared_Passive (Id : E) return B; - function Is_Static_Type (Id : E) return B; - function Is_Statically_Allocated (Id : E) return B; - function Is_Tag (Id : E) return B; - function Is_Tagged_Type (Id : E) return B; - function Is_Thunk (Id : E) return B; - function Is_Trivial_Subprogram (Id : E) return B; - function Is_True_Constant (Id : E) return B; - function Is_Unchecked_Union (Id : E) return B; - function Is_Underlying_Full_View (Id : E) return B; - function Is_Underlying_Record_View (Id : E) return B; - function Is_Unimplemented (Id : E) return B; - function Is_Unsigned_Type (Id : E) return B; - function Is_Uplevel_Referenced_Entity (Id : E) return B; - function Is_Valued_Procedure (Id : E) return B; - function Is_Visible_Formal (Id : E) return B; - function Is_Visible_Lib_Unit (Id : E) return B; - function Is_Volatile (Id : E) return B; - function Is_Volatile_Full_Access (Id : E) return B; - function Itype_Printed (Id : E) return B; - function Kill_Elaboration_Checks (Id : E) return B; - function Kill_Range_Checks (Id : E) return B; - function Known_To_Have_Preelab_Init (Id : E) return B; - function Last_Aggregate_Assignment (Id : E) return N; - function Last_Assignment (Id : E) return N; - function Last_Entity (Id : E) return E; - function Limited_View (Id : E) return E; - function Linker_Section_Pragma (Id : E) return N; - function Lit_Hash (Id : E) return E; - function Lit_Indexes (Id : E) return E; - function Lit_Strings (Id : E) return E; - function Low_Bound_Tested (Id : E) return B; - function Machine_Radix_10 (Id : E) return B; - function Master_Id (Id : E) return E; - function Materialize_Entity (Id : E) return B; - function May_Inherit_Delayed_Rep_Aspects (Id : E) return B; - function Mechanism (Id : E) return M; - function Minimum_Accessibility (Id : E) return E; - function Modulus (Id : E) return U; - function Must_Be_On_Byte_Boundary (Id : E) return B; - function Must_Have_Preelab_Init (Id : E) return B; - function Needs_Activation_Record (Id : E) return B; - function Needs_Debug_Info (Id : E) return B; - function Needs_No_Actuals (Id : E) return B; - function Never_Set_In_Source (Id : E) return B; - function Next_Inlined_Subprogram (Id : E) return E; - function No_Dynamic_Predicate_On_Actual (Id : E) return B; - function No_Pool_Assigned (Id : E) return B; - function No_Predicate_On_Actual (Id : E) return B; - function No_Reordering (Id : E) return B; - function No_Return (Id : E) return B; - function No_Strict_Aliasing (Id : E) return B; - function No_Tagged_Streams_Pragma (Id : E) return N; - function Non_Binary_Modulus (Id : E) return B; - function Non_Limited_View (Id : E) return E; - function Nonzero_Is_True (Id : E) return B; - function Normalized_First_Bit (Id : E) return U; - function Normalized_Position (Id : E) return U; - function Normalized_Position_Max (Id : E) return U; - function OK_To_Rename (Id : E) return B; - function Optimize_Alignment_Space (Id : E) return B; - function Optimize_Alignment_Time (Id : E) return B; - function Original_Access_Type (Id : E) return E; - function Original_Array_Type (Id : E) return E; - function Original_Protected_Subprogram (Id : E) return N; - function Original_Record_Component (Id : E) return E; - function Overlays_Constant (Id : E) return B; - function Overridden_Operation (Id : E) return E; - function Package_Instantiation (Id : E) return N; - function Packed_Array_Impl_Type (Id : E) return E; - function Parent_Subtype (Id : E) return E; - function Part_Of_Constituents (Id : E) return L; - function Part_Of_References (Id : E) return L; - function Partial_View_Has_Unknown_Discr (Id : E) return B; - function Pending_Access_Types (Id : E) return L; - function Postconditions_Proc (Id : E) return E; - function Predicated_Parent (Id : E) return E; - function Predicates_Ignored (Id : E) return B; - function Prev_Entity (Id : E) return E; - function Prival (Id : E) return E; - function Prival_Link (Id : E) return E; - function Private_Dependents (Id : E) return L; - function Protected_Body_Subprogram (Id : E) return E; - function Protected_Formal (Id : E) return E; - function Protected_Subprogram (Id : E) return N; - function Protection_Object (Id : E) return E; - function Reachable (Id : E) return B; - function Receiving_Entry (Id : E) return E; - function Referenced (Id : E) return B; - function Referenced_As_LHS (Id : E) return B; - function Referenced_As_Out_Parameter (Id : E) return B; - function Refinement_Constituents (Id : E) return L; - function Register_Exception_Call (Id : E) return N; - function Related_Array_Object (Id : E) return E; - function Related_Expression (Id : E) return N; - function Related_Instance (Id : E) return E; - function Related_Type (Id : E) return E; - function Relative_Deadline_Variable (Id : E) return E; - function Renamed_Entity (Id : E) return N; - function Renamed_In_Spec (Id : E) return B; - function Renamed_Object (Id : E) return N; - function Renaming_Map (Id : E) return U; - function Requires_Overriding (Id : E) return B; - function Return_Applies_To (Id : E) return N; - function Return_Present (Id : E) return B; - function Returns_By_Ref (Id : E) return B; - function Reverse_Bit_Order (Id : E) return B; - function Reverse_Storage_Order (Id : E) return B; - function Rewritten_For_C (Id : E) return B; - function RM_Size (Id : E) return U; - function Scalar_Range (Id : E) return N; - function Scale_Value (Id : E) return U; - function Scope_Depth_Value (Id : E) return U; - function Sec_Stack_Needed_For_Return (Id : E) return B; - function Shared_Var_Procs_Instance (Id : E) return E; - function Size_Check_Code (Id : E) return N; - function Size_Depends_On_Discriminant (Id : E) return B; - function Size_Known_At_Compile_Time (Id : E) return B; - function Small_Value (Id : E) return R; - function SPARK_Aux_Pragma (Id : E) return N; - function SPARK_Aux_Pragma_Inherited (Id : E) return B; - function SPARK_Pragma (Id : E) return N; - function SPARK_Pragma_Inherited (Id : E) return B; - function Spec_Entity (Id : E) return E; - function SSO_Set_High_By_Default (Id : E) return B; - function SSO_Set_Low_By_Default (Id : E) return B; - function Static_Discrete_Predicate (Id : E) return S; - function Static_Elaboration_Desired (Id : E) return B; - function Static_Initialization (Id : E) return N; - function Static_Real_Or_String_Predicate (Id : E) return N; - function Status_Flag_Or_Transient_Decl (Id : E) return E; - function Storage_Size_Variable (Id : E) return E; - function Stored_Constraint (Id : E) return L; - function Stores_Attribute_Old_Prefix (Id : E) return B; - function Strict_Alignment (Id : E) return B; - function String_Literal_Length (Id : E) return U; - function String_Literal_Low_Bound (Id : E) return N; - function Subprograms_For_Type (Id : E) return L; - function Subps_Index (Id : E) return U; - function Suppress_Elaboration_Warnings (Id : E) return B; - function Suppress_Initialization (Id : E) return B; - function Suppress_Style_Checks (Id : E) return B; - function Suppress_Value_Tracking_On_Call (Id : E) return B; - function Task_Body_Procedure (Id : E) return N; - function Thunk_Entity (Id : E) return E; - function Treat_As_Volatile (Id : E) return B; - function Underlying_Full_View (Id : E) return E; - function Underlying_Record_View (Id : E) return E; - function Universal_Aliasing (Id : E) return B; - function Unset_Reference (Id : E) return N; - function Used_As_Generic_Actual (Id : E) return B; - function Uses_Lock_Free (Id : E) return B; - function Uses_Sec_Stack (Id : E) return B; - function Validated_Object (Id : E) return N; - function Warnings_Off (Id : E) return B; - function Warnings_Off_Used (Id : E) return B; - function Warnings_Off_Used_Unmodified (Id : E) return B; - function Warnings_Off_Used_Unreferenced (Id : E) return B; - function Was_Hidden (Id : E) return B; - function Wrapped_Entity (Id : E) return E; - - ------------------------------- - -- Classification Attributes -- - ------------------------------- - - -- These functions provide a convenient functional notation for testing - -- whether an Ekind value belongs to a specified kind, for example the - -- function Is_Elementary_Type tests if its argument is in Elementary_Kind. - -- In some cases, the test is of an entity attribute (e.g. in the case of - -- Is_Generic_Type where the Ekind does not provide the needed - -- information). - - function Is_Access_Object_Type (Id : E) return B; - function Is_Access_Type (Id : E) return B; - function Is_Access_Protected_Subprogram_Type (Id : E) return B; - function Is_Access_Subprogram_Type (Id : E) return B; - function Is_Aggregate_Type (Id : E) return B; - function Is_Anonymous_Access_Type (Id : E) return B; - function Is_Array_Type (Id : E) return B; - function Is_Assignable (Id : E) return B; - function Is_Class_Wide_Type (Id : E) return B; - function Is_Composite_Type (Id : E) return B; - function Is_Concurrent_Body (Id : E) return B; - function Is_Concurrent_Record_Type (Id : E) return B; - function Is_Concurrent_Type (Id : E) return B; - function Is_Decimal_Fixed_Point_Type (Id : E) return B; - function Is_Digits_Type (Id : E) return B; - function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B; - function Is_Discrete_Type (Id : E) return B; - function Is_Elementary_Type (Id : E) return B; - function Is_Entry (Id : E) return B; - function Is_Enumeration_Type (Id : E) return B; - function Is_Fixed_Point_Type (Id : E) return B; - function Is_Floating_Point_Type (Id : E) return B; - function Is_Formal (Id : E) return B; - function Is_Formal_Object (Id : E) return B; - function Is_Formal_Subprogram (Id : E) return B; - function Is_Generic_Actual_Subprogram (Id : E) return B; - function Is_Generic_Actual_Type (Id : E) return B; - function Is_Generic_Subprogram (Id : E) return B; - function Is_Generic_Type (Id : E) return B; - function Is_Generic_Unit (Id : E) return B; - function Is_Ghost_Entity (Id : E) return B; - function Is_Incomplete_Or_Private_Type (Id : E) return B; - function Is_Incomplete_Type (Id : E) return B; - function Is_Integer_Type (Id : E) return B; - function Is_Limited_Record (Id : E) return B; - function Is_Modular_Integer_Type (Id : E) return B; - function Is_Named_Access_Type (Id : E) return B; - function Is_Named_Number (Id : E) return B; - function Is_Numeric_Type (Id : E) return B; - function Is_Object (Id : E) return B; - function Is_Ordinary_Fixed_Point_Type (Id : E) return B; - function Is_Overloadable (Id : E) return B; - function Is_Private_Type (Id : E) return B; - function Is_Protected_Type (Id : E) return B; - function Is_Real_Type (Id : E) return B; - function Is_Record_Type (Id : E) return B; - function Is_Scalar_Type (Id : E) return B; - function Is_Signed_Integer_Type (Id : E) return B; - function Is_Subprogram (Id : E) return B; - function Is_Subprogram_Or_Entry (Id : E) return B; - function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B; - function Is_Task_Type (Id : E) return B; - function Is_Type (Id : E) return B; - - ------------------------------------- - -- Synthesized Attribute Functions -- - ------------------------------------- - - -- The functions in this section synthesize attributes from the tree, - -- so they do not correspond to defined fields in the entity itself. - - function Address_Clause (Id : E) return N; - function Aft_Value (Id : E) return U; - function Alignment_Clause (Id : E) return N; - function Base_Type (Id : E) return E; - function Component_Alignment (Id : E) return C; - function Declaration_Node (Id : E) return N; - function Designated_Type (Id : E) return E; - function First_Component (Id : E) return E; - function First_Component_Or_Discriminant (Id : E) return E; - function First_Formal (Id : E) return E; - function First_Formal_With_Extras (Id : E) return E; - function Has_Attach_Handler (Id : E) return B; - function Has_DIC (Id : E) return B; - function Has_Entries (Id : E) return B; - function Has_Foreign_Convention (Id : E) return B; - function Has_Interrupt_Handler (Id : E) return B; - function Has_Invariants (Id : E) return B; - function Has_Limited_View (Id : E) return B; - function Has_Non_Limited_View (Id : E) return B; - function Has_Non_Null_Abstract_State (Id : E) return B; - function Has_Non_Null_Visible_Refinement (Id : E) return B; - function Has_Null_Abstract_State (Id : E) return B; - function Has_Null_Visible_Refinement (Id : E) return B; - function Implementation_Base_Type (Id : E) return E; - function Is_Base_Type (Id : E) return B; - function Is_Boolean_Type (Id : E) return B; - function Is_Constant_Object (Id : E) return B; - function Is_Controlled (Id : E) return B; - function Is_Discriminal (Id : E) return B; - function Is_Dynamic_Scope (Id : E) return B; - function Is_Elaboration_Target (Id : E) return B; - function Is_External_State (Id : E) return B; - function Is_Finalizer (Id : E) return B; - function Is_Full_Access (Id : E) return B; - function Is_Null_State (Id : E) return B; - function Is_Package_Or_Generic_Package (Id : E) return B; - function Is_Packed_Array (Id : E) return B; - function Is_Prival (Id : E) return B; - function Is_Protected_Component (Id : E) return B; - function Is_Protected_Interface (Id : E) return B; - function Is_Protected_Record_Type (Id : E) return B; - function Is_Relaxed_Initialization_State (Id : E) return B; - function Is_Standard_Character_Type (Id : E) return B; - function Is_Standard_String_Type (Id : E) return B; - function Is_String_Type (Id : E) return B; - function Is_Synchronized_Interface (Id : E) return B; - function Is_Synchronized_State (Id : E) return B; - function Is_Task_Interface (Id : E) return B; - function Is_Task_Record_Type (Id : E) return B; - function Is_Wrapper_Package (Id : E) return B; - function Last_Formal (Id : E) return E; - function Machine_Emax_Value (Id : E) return U; - function Machine_Emin_Value (Id : E) return U; - function Machine_Mantissa_Value (Id : E) return U; - function Machine_Radix_Value (Id : E) return U; - function Model_Emin_Value (Id : E) return U; - function Model_Epsilon_Value (Id : E) return R; - function Model_Mantissa_Value (Id : E) return U; - function Model_Small_Value (Id : E) return R; - function Next_Component (Id : E) return E; - function Next_Component_Or_Discriminant (Id : E) return E; - function Next_Discriminant (Id : E) return E; - function Next_Formal (Id : E) return E; - function Next_Formal_With_Extras (Id : E) return E; - function Next_Index (Id : N) return N; - function Next_Literal (Id : E) return E; - function Next_Stored_Discriminant (Id : E) return E; - function Number_Dimensions (Id : E) return Pos; - function Number_Entries (Id : E) return Nat; - function Number_Formals (Id : E) return Pos; - function Object_Size_Clause (Id : E) return N; - function Parameter_Mode (Id : E) return Formal_Kind; - function Partial_Refinement_Constituents (Id : E) return L; - function Primitive_Operations (Id : E) return L; - function Root_Type (Id : E) return E; - function Safe_Emax_Value (Id : E) return U; - function Safe_First_Value (Id : E) return R; - function Safe_Last_Value (Id : E) return R; - function Scope_Depth (Id : E) return U; - function Scope_Depth_Set (Id : E) return B; - function Size_Clause (Id : E) return N; - function Stream_Size_Clause (Id : E) return N; - function Type_High_Bound (Id : E) return N; - function Type_Low_Bound (Id : E) return N; - function Underlying_Type (Id : E) return E; - - ---------------------------------------------- - -- Type Representation Attribute Predicates -- - ---------------------------------------------- - - -- These predicates test the setting of the indicated attribute. If the - -- value has been set, then Known is True, and Unknown is False. If no - -- value is set, then Known is False and Unknown is True. The Known_Static - -- predicate is true only if the value is set (Known) and is set to a - -- compile time known value. Note that in the case of Alignment and - -- Normalized_First_Bit, dynamic values are not possible, so we do not - -- need a separate Known_Static calls in these cases. The not set (unknown) - -- values are as follows: - - -- Alignment Uint_0 or No_Uint - -- Component_Size Uint_0 or No_Uint - -- Component_Bit_Offset No_Uint - -- Digits_Value Uint_0 or No_Uint - -- Esize Uint_0 or No_Uint - -- Normalized_First_Bit No_Uint - -- Normalized_Position No_Uint - -- Normalized_Position_Max No_Uint - -- RM_Size Uint_0 or No_Uint - - -- It would be cleaner to use No_Uint in all these cases, but historically - -- we chose to use Uint_0 at first, and the change over will take time ??? - -- This is particularly true for the RM_Size field, where a value of zero - -- is legitimate. We deal with this by a considering that the value is - -- always known static for discrete types (and no other types can have - -- an RM_Size value of zero). - - -- In two cases, Known_Static_Esize and Known_Static_RM_Size, there is one - -- more consideration, which is that we always return False for generic - -- types. Within a template, the size can look known, because of the fake - -- size values we put in template types, but they are not really known and - -- anyone testing if they are known within the template should get False as - -- a result to prevent incorrect assumptions. - - function Known_Alignment (E : Entity_Id) return B; - function Known_Component_Bit_Offset (E : Entity_Id) return B; - function Known_Component_Size (E : Entity_Id) return B; - function Known_Esize (E : Entity_Id) return B; - function Known_Normalized_First_Bit (E : Entity_Id) return B; - function Known_Normalized_Position (E : Entity_Id) return B; - function Known_Normalized_Position_Max (E : Entity_Id) return B; - function Known_RM_Size (E : Entity_Id) return B; - - function Known_Static_Component_Bit_Offset (E : Entity_Id) return B; - function Known_Static_Component_Size (E : Entity_Id) return B; - function Known_Static_Esize (E : Entity_Id) return B; - function Known_Static_Normalized_First_Bit (E : Entity_Id) return B; - function Known_Static_Normalized_Position (E : Entity_Id) return B; - function Known_Static_Normalized_Position_Max (E : Entity_Id) return B; - function Known_Static_RM_Size (E : Entity_Id) return B; - - function Unknown_Alignment (E : Entity_Id) return B; - function Unknown_Component_Bit_Offset (E : Entity_Id) return B; - function Unknown_Component_Size (E : Entity_Id) return B; - function Unknown_Esize (E : Entity_Id) return B; - function Unknown_Normalized_First_Bit (E : Entity_Id) return B; - function Unknown_Normalized_Position (E : Entity_Id) return B; - function Unknown_Normalized_Position_Max (E : Entity_Id) return B; - function Unknown_RM_Size (E : Entity_Id) return B; - - ------------------------------ - -- Attribute Set Procedures -- - ------------------------------ - - -- WARNING: There is a matching C declaration of a few subprograms in fe.h - - procedure Set_Abstract_States (Id : E; V : L); - procedure Set_Accept_Address (Id : E; V : L); - procedure Set_Access_Disp_Table (Id : E; V : L); - procedure Set_Access_Disp_Table_Elab_Flag (Id : E; V : E); - procedure Set_Access_Subprogram_Wrapper (Id : E; V : E); - procedure Set_Activation_Record_Component (Id : E; V : E); - procedure Set_Actual_Subtype (Id : E; V : E); - procedure Set_Address_Taken (Id : E; V : B := True); - procedure Set_Alias (Id : E; V : E); - procedure Set_Alignment (Id : E; V : U); - procedure Set_Anonymous_Designated_Type (Id : E; V : E); - procedure Set_Anonymous_Masters (Id : E; V : L); - procedure Set_Anonymous_Object (Id : E; V : E); - procedure Set_Associated_Entity (Id : E; V : E); - procedure Set_Associated_Formal_Package (Id : E; V : E); - procedure Set_Associated_Node_For_Itype (Id : E; V : N); - procedure Set_Associated_Storage_Pool (Id : E; V : E); - procedure Set_Barrier_Function (Id : E; V : N); - procedure Set_BIP_Initialization_Call (Id : E; V : N); - procedure Set_Block_Node (Id : E; V : N); - procedure Set_Body_Entity (Id : E; V : E); - procedure Set_Body_Needed_For_Inlining (Id : E; V : B := True); - procedure Set_Body_Needed_For_SAL (Id : E; V : B := True); - procedure Set_Body_References (Id : E; V : L); - procedure Set_C_Pass_By_Copy (Id : E; V : B := True); - procedure Set_Can_Never_Be_Null (Id : E; V : B := True); - procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True); - procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True); - procedure Set_Class_Wide_Clone (Id : E; V : E); - procedure Set_Class_Wide_Type (Id : E; V : E); - procedure Set_Cloned_Subtype (Id : E; V : E); - procedure Set_Component_Alignment (Id : E; V : C); - procedure Set_Component_Bit_Offset (Id : E; V : U); - procedure Set_Component_Clause (Id : E; V : N); - procedure Set_Component_Size (Id : E; V : U); - procedure Set_Component_Type (Id : E; V : E); - procedure Set_Contains_Ignored_Ghost_Code (Id : E; V : B := True); - procedure Set_Contract (Id : E; V : N); - procedure Set_Contract_Wrapper (Id : E; V : E); - procedure Set_Corresponding_Concurrent_Type (Id : E; V : E); - procedure Set_Corresponding_Discriminant (Id : E; V : E); - procedure Set_Corresponding_Equality (Id : E; V : E); - procedure Set_Corresponding_Function (Id : E; V : E); - procedure Set_Corresponding_Procedure (Id : E; V : E); - procedure Set_Corresponding_Protected_Entry (Id : E; V : E); - procedure Set_Corresponding_Record_Component (Id : E; V : E); - procedure Set_Corresponding_Record_Type (Id : E; V : E); - procedure Set_Corresponding_Remote_Type (Id : E; V : E); - procedure Set_CR_Discriminant (Id : E; V : E); - procedure Set_Current_Use_Clause (Id : E; V : E); - procedure Set_Current_Value (Id : E; V : N); - procedure Set_Debug_Info_Off (Id : E; V : B := True); - procedure Set_Debug_Renaming_Link (Id : E; V : E); - procedure Set_Default_Aspect_Component_Value (Id : E; V : N); - procedure Set_Default_Aspect_Value (Id : E; V : N); - procedure Set_Default_Expr_Function (Id : E; V : E); - procedure Set_Default_Expressions_Processed (Id : E; V : B := True); - procedure Set_Default_Value (Id : E; V : N); - procedure Set_Delay_Cleanups (Id : E; V : B := True); - procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True); - procedure Set_Delta_Value (Id : E; V : R); - procedure Set_Dependent_Instances (Id : E; V : L); - procedure Set_Depends_On_Private (Id : E; V : B := True); - procedure Set_Derived_Type_Link (Id : E; V : E); - procedure Set_Digits_Value (Id : E; V : U); - procedure Set_Predicated_Parent (Id : E; V : E); - procedure Set_Predicates_Ignored (Id : E; V : B); - procedure Set_Direct_Primitive_Operations (Id : E; V : L); - procedure Set_Directly_Designated_Type (Id : E; V : E); - procedure Set_Disable_Controlled (Id : E; V : B := True); - procedure Set_Discard_Names (Id : E; V : B := True); - procedure Set_Discriminal (Id : E; V : E); - procedure Set_Discriminal_Link (Id : E; V : E); - procedure Set_Discriminant_Checking_Func (Id : E; V : E); - procedure Set_Discriminant_Constraint (Id : E; V : L); - procedure Set_Discriminant_Default_Value (Id : E; V : N); - procedure Set_Discriminant_Number (Id : E; V : U); - procedure Set_Dispatch_Table_Wrappers (Id : E; V : L); - procedure Set_DT_Entry_Count (Id : E; V : U); - procedure Set_DT_Offset_To_Top_Func (Id : E; V : E); - procedure Set_DT_Position (Id : E; V : U); - procedure Set_DTC_Entity (Id : E; V : E); - procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True); - procedure Set_Elaboration_Entity (Id : E; V : E); - procedure Set_Elaboration_Entity_Required (Id : E; V : B := True); - procedure Set_Encapsulating_State (Id : E; V : E); - procedure Set_Enclosing_Scope (Id : E; V : E); - procedure Set_Entry_Accepted (Id : E; V : B := True); - procedure Set_Entry_Bodies_Array (Id : E; V : E); - procedure Set_Entry_Cancel_Parameter (Id : E; V : E); - procedure Set_Entry_Component (Id : E; V : E); - procedure Set_Entry_Formal (Id : E; V : E); - procedure Set_Entry_Index_Constant (Id : E; V : E); - procedure Set_Entry_Max_Queue_Lengths_Array (Id : E; V : E); - procedure Set_Entry_Parameters_Type (Id : E; V : E); - procedure Set_Enum_Pos_To_Rep (Id : E; V : E); - procedure Set_Enumeration_Pos (Id : E; V : U); - procedure Set_Enumeration_Rep (Id : E; V : U); - procedure Set_Enumeration_Rep_Expr (Id : E; V : N); - procedure Set_Equivalent_Type (Id : E; V : E); - procedure Set_Esize (Id : E; V : U); - procedure Set_Extra_Accessibility (Id : E; V : E); - procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E); - procedure Set_Extra_Constrained (Id : E; V : E); - procedure Set_Extra_Formal (Id : E; V : E); - procedure Set_Extra_Formals (Id : E; V : E); - procedure Set_Finalization_Master (Id : E; V : E); - procedure Set_Finalize_Storage_Only (Id : E; V : B := True); - procedure Set_Finalizer (Id : E; V : E); - procedure Set_First_Entity (Id : E; V : E); - procedure Set_First_Exit_Statement (Id : E; V : N); - procedure Set_First_Index (Id : E; V : N); - procedure Set_First_Literal (Id : E; V : E); - procedure Set_First_Private_Entity (Id : E; V : E); - procedure Set_First_Rep_Item (Id : E; V : N); - procedure Set_Float_Rep (Id : E; V : F); - procedure Set_Freeze_Node (Id : E; V : N); - procedure Set_From_Limited_With (Id : E; V : B := True); - procedure Set_Full_View (Id : E; V : E); - procedure Set_Generic_Homonym (Id : E; V : E); - procedure Set_Generic_Renamings (Id : E; V : L); - procedure Set_Handler_Records (Id : E; V : S); - procedure Set_Has_Aliased_Components (Id : E; V : B := True); - procedure Set_Has_Alignment_Clause (Id : E; V : B := True); - procedure Set_Has_All_Calls_Remote (Id : E; V : B := True); - procedure Set_Has_Atomic_Components (Id : E; V : B := True); - procedure Set_Has_Biased_Representation (Id : E; V : B := True); - procedure Set_Has_Completion (Id : E; V : B := True); - procedure Set_Has_Completion_In_Body (Id : E; V : B := True); - procedure Set_Has_Complex_Representation (Id : E; V : B := True); - procedure Set_Has_Component_Size_Clause (Id : E; V : B := True); - procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True); - procedure Set_Has_Contiguous_Rep (Id : E; V : B := True); - procedure Set_Has_Controlled_Component (Id : E; V : B := True); - procedure Set_Has_Controlling_Result (Id : E; V : B := True); - procedure Set_Has_Convention_Pragma (Id : E; V : B := True); - procedure Set_Has_Default_Aspect (Id : E; V : B := True); - procedure Set_Has_Delayed_Aspects (Id : E; V : B := True); - procedure Set_Has_Delayed_Freeze (Id : E; V : B := True); - procedure Set_Has_Delayed_Rep_Aspects (Id : E; V : B := True); - procedure Set_Has_Discriminants (Id : E; V : B := True); - procedure Set_Has_Dispatch_Table (Id : E; V : B := True); - procedure Set_Has_Dynamic_Predicate_Aspect (Id : E; V : B := True); - procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True); - procedure Set_Has_Exit (Id : E; V : B := True); - procedure Set_Has_Expanded_Contract (Id : E; V : B := True); - procedure Set_Has_Forward_Instantiation (Id : E; V : B := True); - procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True); - procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True); - procedure Set_Has_Homonym (Id : E; V : B := True); - procedure Set_Has_Implicit_Dereference (Id : E; V : B := True); - procedure Set_Has_Independent_Components (Id : E; V : B := True); - procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True); - procedure Set_Has_Inherited_DIC (Id : E; V : B := True); - procedure Set_Has_Inherited_Invariants (Id : E; V : B := True); - procedure Set_Has_Initial_Value (Id : E; V : B := True); - procedure Set_Has_Loop_Entry_Attributes (Id : E; V : B := True); - procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True); - procedure Set_Has_Master_Entity (Id : E; V : B := True); - procedure Set_Has_Missing_Return (Id : E; V : B := True); - procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True); - procedure Set_Has_Nested_Subprogram (Id : E; V : B := True); - procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True); - procedure Set_Has_Object_Size_Clause (Id : E; V : B := True); - procedure Set_Has_Out_Or_In_Out_Parameter (Id : E; V : B := True); - procedure Set_Has_Own_DIC (Id : E; V : B := True); - procedure Set_Has_Own_Invariants (Id : E; V : B := True); - procedure Set_Has_Partial_Visible_Refinement (Id : E; V : B := True); - procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True); - procedure Set_Has_Pragma_Controlled (Id : E; V : B := True); - procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True); - procedure Set_Has_Pragma_Inline (Id : E; V : B := True); - procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True); - procedure Set_Has_Pragma_No_Inline (Id : E; V : B := True); - procedure Set_Has_Pragma_Ordered (Id : E; V : B := True); - procedure Set_Has_Pragma_Pack (Id : E; V : B := True); - procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True); - procedure Set_Has_Pragma_Pure (Id : E; V : B := True); - procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True); - procedure Set_Has_Pragma_Thread_Local_Storage (Id : E; V : B := True); - procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True); - procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True); - procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True); - procedure Set_Has_Pragma_Unused (Id : E; V : B := True); - procedure Set_Has_Predicates (Id : E; V : B := True); - procedure Set_Has_Primitive_Operations (Id : E; V : B := True); - procedure Set_Has_Private_Ancestor (Id : E; V : B := True); - procedure Set_Has_Private_Declaration (Id : E; V : B := True); - procedure Set_Has_Private_Extension (Id : E; V : B := True); - procedure Set_Has_Protected (Id : E; V : B := True); - procedure Set_Has_Qualified_Name (Id : E; V : B := True); - procedure Set_Has_RACW (Id : E; V : B := True); - procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True); - procedure Set_Has_Recursive_Call (Id : E; V : B := True); - procedure Set_Has_Shift_Operator (Id : E; V : B := True); - procedure Set_Has_Size_Clause (Id : E; V : B := True); - procedure Set_Has_Small_Clause (Id : E; V : B := True); - procedure Set_Has_Specified_Layout (Id : E; V : B := True); - procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True); - procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True); - procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True); - procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True); - procedure Set_Has_Static_Discriminants (Id : E; V : B := True); - procedure Set_Has_Static_Predicate (Id : E; V : B := True); - procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True); - procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True); - procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True); - procedure Set_Has_Task (Id : E; V : B := True); - procedure Set_Has_Timing_Event (Id : E; V : B := True); - procedure Set_Has_Thunks (Id : E; V : B := True); - procedure Set_Has_Unchecked_Union (Id : E; V : B := True); - procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True); - procedure Set_Has_Visible_Refinement (Id : E; V : B := True); - procedure Set_Has_Volatile_Components (Id : E; V : B := True); - procedure Set_Has_Xref_Entry (Id : E; V : B := True); - procedure Set_Has_Yield_Aspect (Id : E; V : B := True); - procedure Set_Hiding_Loop_Variable (Id : E; V : E); - procedure Set_Hidden_In_Formal_Instance (Id : E; V : L); - procedure Set_Homonym (Id : E; V : E); - procedure Set_Ignore_SPARK_Mode_Pragmas (Id : E; V : B := True); - procedure Set_Import_Pragma (Id : E; V : E); - procedure Set_Incomplete_Actuals (Id : E; V : L); - procedure Set_In_Package_Body (Id : E; V : B := True); - procedure Set_In_Private_Part (Id : E; V : B := True); - procedure Set_In_Use (Id : E; V : B := True); - procedure Set_Initialization_Statements (Id : E; V : N); - procedure Set_Inner_Instances (Id : E; V : L); - procedure Set_Interface_Alias (Id : E; V : E); - procedure Set_Interface_Name (Id : E; V : N); - procedure Set_Interfaces (Id : E; V : L); - procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True); - procedure Set_Is_Abstract_Type (Id : E; V : B := True); - procedure Set_Is_Access_Constant (Id : E; V : B := True); - procedure Set_Is_Activation_Record (Id : E; V : B := True); - procedure Set_Is_Actual_Subtype (Id : E; V : B := True); - procedure Set_Is_Ada_2005_Only (Id : E; V : B := True); - procedure Set_Is_Ada_2012_Only (Id : E; V : B := True); - procedure Set_Is_Aliased (Id : E; V : B := True); - procedure Set_Is_Asynchronous (Id : E; V : B := True); - procedure Set_Is_Atomic (Id : E; V : B := True); - procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True); - procedure Set_Is_Called (Id : E; V : B := True); - procedure Set_Is_Character_Type (Id : E; V : B := True); - procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True); - procedure Set_Is_Child_Unit (Id : E; V : B := True); - procedure Set_Is_Class_Wide_Clone (Id : E; V : B := True); - procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True); - procedure Set_Is_Compilation_Unit (Id : E; V : B := True); - procedure Set_Is_Completely_Hidden (Id : E; V : B := True); - procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True); - procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True); - procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True); - procedure Set_Is_Constrained (Id : E; V : B := True); - procedure Set_Is_Constructor (Id : E; V : B := True); - procedure Set_Is_Controlled_Active (Id : E; V : B := True); - procedure Set_Is_Controlling_Formal (Id : E; V : B := True); - procedure Set_Is_CPP_Class (Id : E; V : B := True); - procedure Set_Is_CUDA_Kernel (Id : E; V : B := True); - procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True); - procedure Set_Is_DIC_Procedure (Id : E; V : B := True); - procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True); - procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True); - procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True); - procedure Set_Is_Dispatching_Operation (Id : E; V : B := True); - procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True); - procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True); - procedure Set_Is_Eliminated (Id : E; V : B := True); - procedure Set_Is_Entry_Formal (Id : E; V : B := True); - procedure Set_Is_Entry_Wrapper (Id : E; V : B := True); - procedure Set_Is_Exception_Handler (Id : E; V : B := True); - procedure Set_Is_Exported (Id : E; V : B := True); - procedure Set_Is_Finalized_Transient (Id : E; V : B := True); - procedure Set_Is_First_Subtype (Id : E; V : B := True); - procedure Set_Is_Formal_Subprogram (Id : E; V : B := True); - procedure Set_Is_Frozen (Id : E; V : B := True); - procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True); - procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True); - procedure Set_Is_Generic_Instance (Id : E; V : B := True); - procedure Set_Is_Generic_Type (Id : E; V : B := True); - procedure Set_Is_Hidden (Id : E; V : B := True); - procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True); - procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True); - procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True); - procedure Set_Is_Ignored_Transient (Id : E; V : B := True); - procedure Set_Is_Immediately_Visible (Id : E; V : B := True); - procedure Set_Is_Implementation_Defined (Id : E; V : B := True); - procedure Set_Is_Imported (Id : E; V : B := True); - procedure Set_Is_Independent (Id : E; V : B := True); - procedure Set_Is_Initial_Condition_Procedure (Id : E; V : B := True); - procedure Set_Is_Inlined (Id : E; V : B := True); - procedure Set_Is_Inlined_Always (Id : E; V : B := True); - procedure Set_Is_Instantiated (Id : E; V : B := True); - procedure Set_Is_Interface (Id : E; V : B := True); - procedure Set_Is_Internal (Id : E; V : B := True); - procedure Set_Is_Interrupt_Handler (Id : E; V : B := True); - procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True); - procedure Set_Is_Invariant_Procedure (Id : E; V : B := True); - procedure Set_Is_Itype (Id : E; V : B := True); - procedure Set_Is_Known_Non_Null (Id : E; V : B := True); - procedure Set_Is_Known_Null (Id : E; V : B := True); - procedure Set_Is_Known_Valid (Id : E; V : B := True); - procedure Set_Is_Limited_Composite (Id : E; V : B := True); - procedure Set_Is_Limited_Interface (Id : E; V : B := True); - procedure Set_Is_Limited_Record (Id : E; V : B := True); - procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True); - procedure Set_Is_Loop_Parameter (Id : E; V : B := True); - procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True); - procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True); - procedure Set_Is_Null_Init_Proc (Id : E; V : B := True); - procedure Set_Is_Obsolescent (Id : E; V : B := True); - procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True); - procedure Set_Is_Package_Body_Entity (Id : E; V : B := True); - procedure Set_Is_Packed (Id : E; V : B := True); - procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True); - procedure Set_Is_Param_Block_Component_Type (Id : E; V : B := True); - procedure Set_Is_Partial_Invariant_Procedure (Id : E; V : B := True); - procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True); - procedure Set_Is_Predicate_Function (Id : E; V : B := True); - procedure Set_Is_Predicate_Function_M (Id : E; V : B := True); - procedure Set_Is_Preelaborated (Id : E; V : B := True); - procedure Set_Is_Primitive (Id : E; V : B := True); - procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True); - procedure Set_Is_Private_Composite (Id : E; V : B := True); - procedure Set_Is_Private_Descendant (Id : E; V : B := True); - procedure Set_Is_Private_Primitive (Id : E; V : B := True); - procedure Set_Is_Public (Id : E; V : B := True); - procedure Set_Is_Pure (Id : E; V : B := True); - procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True); - procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True); - procedure Set_Is_Raised (Id : E; V : B := True); - procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True); - procedure Set_Is_Remote_Types (Id : E; V : B := True); - procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True); - procedure Set_Is_Return_Object (Id : E; V : B := True); - procedure Set_Is_Safe_To_Reevaluate (Id : E; V : B := True); - procedure Set_Is_Shared_Passive (Id : E; V : B := True); - procedure Set_Is_Static_Type (Id : E; V : B := True); - procedure Set_Is_Statically_Allocated (Id : E; V : B := True); - procedure Set_Is_Tag (Id : E; V : B := True); - procedure Set_Is_Tagged_Type (Id : E; V : B := True); - procedure Set_Is_Thunk (Id : E; V : B := True); - procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True); - procedure Set_Is_True_Constant (Id : E; V : B := True); - procedure Set_Is_Unchecked_Union (Id : E; V : B := True); - procedure Set_Is_Underlying_Full_View (Id : E; V : B := True); - procedure Set_Is_Underlying_Record_View (Id : E; V : B := True); - procedure Set_Is_Unimplemented (Id : E; V : B := True); - procedure Set_Is_Unsigned_Type (Id : E; V : B := True); - procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True); - procedure Set_Is_Valued_Procedure (Id : E; V : B := True); - procedure Set_Is_Visible_Formal (Id : E; V : B := True); - procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True); - procedure Set_Is_Volatile (Id : E; V : B := True); - procedure Set_Is_Volatile_Full_Access (Id : E; V : B := True); - procedure Set_Itype_Printed (Id : E; V : B := True); - procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True); - procedure Set_Kill_Range_Checks (Id : E; V : B := True); - procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True); - procedure Set_Last_Aggregate_Assignment (Id : E; V : N); - procedure Set_Last_Assignment (Id : E; V : N); - procedure Set_Last_Entity (Id : E; V : E); - procedure Set_Limited_View (Id : E; V : E); - procedure Set_Linker_Section_Pragma (Id : E; V : N); - procedure Set_Lit_Hash (Id : E; V : E); - procedure Set_Lit_Indexes (Id : E; V : E); - procedure Set_Lit_Strings (Id : E; V : E); - procedure Set_Low_Bound_Tested (Id : E; V : B := True); - procedure Set_Machine_Radix_10 (Id : E; V : B := True); - procedure Set_Master_Id (Id : E; V : E); - procedure Set_Materialize_Entity (Id : E; V : B := True); - procedure Set_May_Inherit_Delayed_Rep_Aspects (Id : E; V : B := True); - procedure Set_Mechanism (Id : E; V : M); - procedure Set_Minimum_Accessibility (Id : E; V : E); - procedure Set_Modulus (Id : E; V : U); - procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True); - procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True); - procedure Set_Needs_Activation_Record (Id : E; V : B := True); - procedure Set_Needs_Debug_Info (Id : E; V : B := True); - procedure Set_Needs_No_Actuals (Id : E; V : B := True); - procedure Set_Never_Set_In_Source (Id : E; V : B := True); - procedure Set_Next_Inlined_Subprogram (Id : E; V : E); - procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True); - procedure Set_No_Pool_Assigned (Id : E; V : B := True); - procedure Set_No_Predicate_On_Actual (Id : E; V : B := True); - procedure Set_No_Reordering (Id : E; V : B := True); - procedure Set_No_Return (Id : E; V : B := True); - procedure Set_No_Strict_Aliasing (Id : E; V : B := True); - procedure Set_No_Tagged_Streams_Pragma (Id : E; V : N); - procedure Set_Non_Binary_Modulus (Id : E; V : B := True); - procedure Set_Non_Limited_View (Id : E; V : E); - procedure Set_Nonzero_Is_True (Id : E; V : B := True); - procedure Set_Normalized_First_Bit (Id : E; V : U); - procedure Set_Normalized_Position (Id : E; V : U); - procedure Set_Normalized_Position_Max (Id : E; V : U); - procedure Set_OK_To_Rename (Id : E; V : B := True); - procedure Set_Optimize_Alignment_Space (Id : E; V : B := True); - procedure Set_Optimize_Alignment_Time (Id : E; V : B := True); - procedure Set_Original_Access_Type (Id : E; V : E); - procedure Set_Original_Array_Type (Id : E; V : E); - procedure Set_Original_Protected_Subprogram (Id : E; V : N); - procedure Set_Original_Record_Component (Id : E; V : E); - procedure Set_Overlays_Constant (Id : E; V : B := True); - procedure Set_Overridden_Operation (Id : E; V : E); - procedure Set_Package_Instantiation (Id : E; V : N); - procedure Set_Packed_Array_Impl_Type (Id : E; V : E); - procedure Set_Parent_Subtype (Id : E; V : E); - procedure Set_Part_Of_Constituents (Id : E; V : L); - procedure Set_Part_Of_References (Id : E; V : L); - procedure Set_Partial_View_Has_Unknown_Discr (Id : E; V : B := True); - procedure Set_Pending_Access_Types (Id : E; V : L); - procedure Set_Postconditions_Proc (Id : E; V : E); - procedure Set_Prev_Entity (Id : E; V : E); - procedure Set_Prival (Id : E; V : E); - procedure Set_Prival_Link (Id : E; V : E); - procedure Set_Private_Dependents (Id : E; V : L); - procedure Set_Protected_Body_Subprogram (Id : E; V : E); - procedure Set_Protected_Formal (Id : E; V : E); - procedure Set_Protected_Subprogram (Id : E; V : N); - procedure Set_Protection_Object (Id : E; V : E); - procedure Set_Reachable (Id : E; V : B := True); - procedure Set_Receiving_Entry (Id : E; V : E); - procedure Set_Referenced (Id : E; V : B := True); - procedure Set_Referenced_As_LHS (Id : E; V : B := True); - procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True); - procedure Set_Refinement_Constituents (Id : E; V : L); - procedure Set_Register_Exception_Call (Id : E; V : N); - procedure Set_Related_Array_Object (Id : E; V : E); - procedure Set_Related_Expression (Id : E; V : N); - procedure Set_Related_Instance (Id : E; V : E); - procedure Set_Related_Type (Id : E; V : E); - procedure Set_Relative_Deadline_Variable (Id : E; V : E); - procedure Set_Renamed_Entity (Id : E; V : N); - procedure Set_Renamed_In_Spec (Id : E; V : B := True); - procedure Set_Renamed_Object (Id : E; V : N); - procedure Set_Renaming_Map (Id : E; V : U); - procedure Set_Requires_Overriding (Id : E; V : B := True); - procedure Set_Return_Applies_To (Id : E; V : N); - procedure Set_Return_Present (Id : E; V : B := True); - procedure Set_Returns_By_Ref (Id : E; V : B := True); - procedure Set_Reverse_Bit_Order (Id : E; V : B := True); - procedure Set_Reverse_Storage_Order (Id : E; V : B := True); - procedure Set_Rewritten_For_C (Id : E; V : B := True); - procedure Set_RM_Size (Id : E; V : U); - procedure Set_Scalar_Range (Id : E; V : N); - procedure Set_Scale_Value (Id : E; V : U); - procedure Set_Scope_Depth_Value (Id : E; V : U); - procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True); - procedure Set_Shared_Var_Procs_Instance (Id : E; V : E); - procedure Set_Size_Check_Code (Id : E; V : N); - procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True); - procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True); - procedure Set_Small_Value (Id : E; V : R); - procedure Set_SPARK_Aux_Pragma (Id : E; V : N); - procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True); - procedure Set_SPARK_Pragma (Id : E; V : N); - procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True); - procedure Set_Spec_Entity (Id : E; V : E); - procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True); - procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True); - procedure Set_Static_Discrete_Predicate (Id : E; V : S); - procedure Set_Static_Elaboration_Desired (Id : E; V : B); - procedure Set_Static_Initialization (Id : E; V : N); - procedure Set_Static_Real_Or_String_Predicate (Id : E; V : N); - procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E); - procedure Set_Storage_Size_Variable (Id : E; V : E); - procedure Set_Stored_Constraint (Id : E; V : L); - procedure Set_Stores_Attribute_Old_Prefix (Id : E; V : B := True); - procedure Set_Strict_Alignment (Id : E; V : B := True); - procedure Set_String_Literal_Length (Id : E; V : U); - procedure Set_String_Literal_Low_Bound (Id : E; V : N); - procedure Set_Subprograms_For_Type (Id : E; V : L); - procedure Set_Subps_Index (Id : E; V : U); - procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True); - procedure Set_Suppress_Initialization (Id : E; V : B := True); - procedure Set_Suppress_Style_Checks (Id : E; V : B := True); - procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True); - procedure Set_Task_Body_Procedure (Id : E; V : N); - procedure Set_Thunk_Entity (Id : E; V : E); - procedure Set_Treat_As_Volatile (Id : E; V : B := True); - procedure Set_Underlying_Full_View (Id : E; V : E); - procedure Set_Underlying_Record_View (Id : E; V : E); - procedure Set_Universal_Aliasing (Id : E; V : B := True); - procedure Set_Unset_Reference (Id : E; V : N); - procedure Set_Used_As_Generic_Actual (Id : E; V : B := True); - procedure Set_Uses_Lock_Free (Id : E; V : B := True); - procedure Set_Uses_Sec_Stack (Id : E; V : B := True); - procedure Set_Validated_Object (Id : E; V : N); - procedure Set_Warnings_Off (Id : E; V : B := True); - procedure Set_Warnings_Off_Used (Id : E; V : B := True); - procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True); - procedure Set_Warnings_Off_Used_Unreferenced (Id : E; V : B := True); - procedure Set_Was_Hidden (Id : E; V : B := True); - procedure Set_Wrapped_Entity (Id : E; V : E); - - --------------------------------------------------- - -- Access to Subprograms in Subprograms_For_Type -- - --------------------------------------------------- - - function DIC_Procedure (Id : E) return E; - function Partial_DIC_Procedure (Id : E) return E; - function Invariant_Procedure (Id : E) return E; - function Partial_Invariant_Procedure (Id : E) return E; - function Predicate_Function (Id : E) return E; - function Predicate_Function_M (Id : E) return E; - - procedure Set_DIC_Procedure (Id : E; V : E); - procedure Set_Partial_DIC_Procedure (Id : E; V : E); - procedure Set_Invariant_Procedure (Id : E; V : E); - procedure Set_Partial_Invariant_Procedure (Id : E; V : E); - procedure Set_Predicate_Function (Id : E; V : E); - procedure Set_Predicate_Function_M (Id : E; V : E); - - ----------------------------------- - -- Field Initialization Routines -- - ----------------------------------- - - -- These routines are overloadings of some of the above Set procedures - -- where the argument is normally a Uint. The overloadings take an Int - -- parameter instead, and appropriately convert it. There are also - -- versions that implicitly initialize to the appropriate "not set" - -- value. The not set (unknown) values are as follows: - - -- Alignment Uint_0 - -- Component_Size Uint_0 - -- Component_Bit_Offset No_Uint - -- Digits_Value Uint_0 - -- Esize Uint_0 - -- Normalized_First_Bit No_Uint - -- Normalized_Position No_Uint - -- Normalized_Position_Max No_Uint - -- RM_Size Uint_0 - - -- It would be cleaner to use No_Uint in all these cases, but historically - -- we chose to use Uint_0 at first, and the change over will take time ??? - -- This is particularly true for the RM_Size field, where a value of zero - -- is legitimate and causes some special tests around the code. - - -- Contrary to the corresponding Set procedures above, these routines - -- do NOT check the entity kind of their argument, instead they set the - -- underlying Uint fields directly (this allows them to be used for - -- entities whose Ekind has not been set yet). - - procedure Init_Alignment (Id : E; V : Int); - procedure Init_Component_Bit_Offset (Id : E; V : Int); - procedure Init_Component_Size (Id : E; V : Int); - procedure Init_Digits_Value (Id : E; V : Int); - procedure Init_Esize (Id : E; V : Int); - procedure Init_Normalized_First_Bit (Id : E; V : Int); - procedure Init_Normalized_Position (Id : E; V : Int); - procedure Init_Normalized_Position_Max (Id : E; V : Int); - procedure Init_RM_Size (Id : E; V : Int); - - procedure Init_Alignment (Id : E); - procedure Init_Component_Bit_Offset (Id : E); - procedure Init_Component_Size (Id : E); - procedure Init_Digits_Value (Id : E); - procedure Init_Esize (Id : E); - procedure Init_Normalized_First_Bit (Id : E); - procedure Init_Normalized_Position (Id : E); - procedure Init_Normalized_Position_Max (Id : E); - procedure Init_RM_Size (Id : E); - - procedure Init_Component_Location (Id : E); - -- Initializes all fields describing the location of a component - -- (Normalized_Position, Component_Bit_Offset, Normalized_First_Bit, - -- Normalized_Position_Max, Esize) to all be Unknown. - - procedure Init_Size (Id : E; V : Int); - -- Initialize both the Esize and RM_Size fields of E to V - - procedure Init_Size_Align (Id : E); - -- This procedure initializes both size fields and the alignment - -- field to all be Unknown. - - procedure Init_Object_Size_Align (Id : E); - -- Same as Init_Size_Align except RM_Size field (which is only for types) - -- is unaffected. - - --------------- - -- Iterators -- - --------------- - - -- The call to Next_xxx (obj) is equivalent to obj := Next_xxx (obj) - -- We define the set of Proc_Next_xxx routines simply for the purposes - -- of inlining them without necessarily inlining the function. - - procedure Proc_Next_Component (N : in out Node_Id); - procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id); - procedure Proc_Next_Discriminant (N : in out Node_Id); - procedure Proc_Next_Formal (N : in out Node_Id); - procedure Proc_Next_Formal_With_Extras (N : in out Node_Id); - procedure Proc_Next_Index (N : in out Node_Id); - procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id); - procedure Proc_Next_Literal (N : in out Node_Id); - procedure Proc_Next_Stored_Discriminant (N : in out Node_Id); - - pragma Inline (Proc_Next_Component); - pragma Inline (Proc_Next_Component_Or_Discriminant); - pragma Inline (Proc_Next_Discriminant); - pragma Inline (Proc_Next_Formal); - pragma Inline (Proc_Next_Formal_With_Extras); - pragma Inline (Proc_Next_Index); - pragma Inline (Proc_Next_Inlined_Subprogram); - pragma Inline (Proc_Next_Literal); - pragma Inline (Proc_Next_Stored_Discriminant); - - procedure Next_Component (N : in out Node_Id) - renames Proc_Next_Component; - - procedure Next_Component_Or_Discriminant (N : in out Node_Id) - renames Proc_Next_Component_Or_Discriminant; - - procedure Next_Discriminant (N : in out Node_Id) - renames Proc_Next_Discriminant; - - procedure Next_Formal (N : in out Node_Id) - renames Proc_Next_Formal; - - procedure Next_Formal_With_Extras (N : in out Node_Id) - renames Proc_Next_Formal_With_Extras; - - procedure Next_Index (N : in out Node_Id) - renames Proc_Next_Index; - - procedure Next_Inlined_Subprogram (N : in out Node_Id) - renames Proc_Next_Inlined_Subprogram; - - procedure Next_Literal (N : in out Node_Id) - renames Proc_Next_Literal; - - procedure Next_Stored_Discriminant (N : in out Node_Id) - renames Proc_Next_Stored_Discriminant; - - --------------------------- - -- Testing Warning Flags -- - --------------------------- - - -- These routines are to be used rather than testing flags Warnings_Off, - -- Has_Pragma_Unmodified, Has_Pragma_Unreferenced. They deal with setting - -- the flags Warnings_Off_Used[_Unmodified|Unreferenced] for later access. - - function Has_Warnings_Off (E : Entity_Id) return Boolean; - -- If Warnings_Off is set on E, then returns True and also sets the flag - -- Warnings_Off_Used on E. If Warnings_Off is not set on E, returns False - -- and has no side effect. - - function Has_Unmodified (E : Entity_Id) return Boolean; - -- If flag Has_Pragma_Unmodified is set on E, returns True with no side - -- effects. Otherwise if Warnings_Off is set on E, returns True and also - -- sets the flag Warnings_Off_Used_Unmodified on E. If neither of the flags - -- Warnings_Off nor Has_Pragma_Unmodified is set, returns False with no - -- side effects. - - function Has_Unreferenced (E : Entity_Id) return Boolean; - -- If flag Has_Pragma_Unreferenced is set on E, returns True with no side - -- effects. Otherwise if Warnings_Off is set on E, returns True and also - -- sets the flag Warnings_Off_Used_Unreferenced on E. If neither of the - -- flags Warnings_Off nor Has_Pragma_Unreferenced is set, returns False - -- with no side effects. - - ---------------------------------------------- - -- Subprograms for Accessing Rep Item Chain -- - ---------------------------------------------- - - -- The First_Rep_Item field of every entity points to a linked list (linked - -- through Next_Rep_Item) of representation pragmas, attribute definition - -- clauses, representation clauses, and aspect specifications that apply to - -- the item. Note that in the case of types, it is assumed that any such - -- rep items for a base type also apply to all subtypes. This is achieved - -- by having the chain for subtypes link onto the chain for the base type, - -- so that new entries for the subtype are added at the start of the chain. - -- - -- Note: aspect specification nodes are linked only when evaluation of the - -- expression is deferred to the freeze point. For further details see - -- Sem_Ch13.Analyze_Aspect_Specifications. - - function Get_Attribute_Definition_Clause - (E : Entity_Id; - Id : Attribute_Id) return Node_Id; - -- Searches the Rep_Item chain for a given entity E, for an instance of an - -- attribute definition clause with the given attribute Id. If found, the - -- value returned is the N_Attribute_Definition_Clause node, otherwise - -- Empty is returned. - - -- WARNING: There is a matching C declaration of this subprogram in fe.h - - function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id; - -- Searches the Rep_Item chain of entity E, for an instance of a pragma - -- with the given pragma Id. If found, the value returned is the N_Pragma - -- node, otherwise Empty is returned. The following contract pragmas that - -- appear in N_Contract nodes are also handled by this routine: - -- Abstract_State - -- Async_Readers - -- Async_Writers - -- Attach_Handler - -- Constant_After_Elaboration - -- Contract_Cases - -- Depends - -- Effective_Reads - -- Effective_Writes - -- Global - -- Initial_Condition - -- Initializes - -- Interrupt_Handler - -- No_Caching - -- Part_Of - -- Precondition - -- Postcondition - -- Refined_Depends - -- Refined_Global - -- Refined_Post - -- Refined_State - -- Subprogram_Variant - -- Test_Case - -- Volatile_Function - - function Get_Class_Wide_Pragma - (E : Entity_Id; - Id : Pragma_Id) return Node_Id; - -- Examine Rep_Item chain to locate a classwide pre- or postcondition of a - -- primitive operation. Returns Empty if not present. - - function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id; - -- Searches the Rep_Item chain for a given entity E, for a record - -- representation clause, and if found, returns it. Returns Empty - -- if no such clause is found. - - function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean; - -- Return True if N is present in the Rep_Item chain for a given entity E - - procedure Record_Rep_Item (E : Entity_Id; N : Node_Id); - -- N is the node for a representation pragma, representation clause, an - -- attribute definition clause, or an aspect specification that applies to - -- entity E. This procedure links the node N onto the Rep_Item chain for - -- entity E. Note that it is an error to call this procedure with E being - -- overloadable, and N being a pragma that applies to multiple overloadable - -- entities (Convention, Interface, Inline, Inline_Always, Import, Export, - -- External). This is not allowed even in the case where the entity is not - -- overloaded, since we can't rely on it being present in the overloaded - -- case, it is not useful to have it present in the non-overloaded case. - - ------------------------------- - -- Miscellaneous Subprograms -- - ------------------------------- - - procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id); - -- Add an entity to the list of entities declared in the scope Scop - - function Get_Full_View (T : Entity_Id) return Entity_Id; - -- If T is an incomplete type and the full declaration has been seen, or - -- is the name of a class_wide type whose root is incomplete, return the - -- corresponding full declaration, else return T itself. - - function Is_Entity_Name (N : Node_Id) return Boolean; - -- Test if the node N is the name of an entity (i.e. is an identifier, - -- expanded name, or an attribute reference that returns an entity). - - -- WARNING: There is a matching C declaration of this subprogram in fe.h - - procedure Link_Entities (First : Entity_Id; Second : Entity_Id); - -- Link entities First and Second in one entity chain. - -- - -- NOTE: No updates are done to the First_Entity and Last_Entity fields - -- of the scope. - - procedure Remove_Entity (Id : Entity_Id); - -- Remove entity Id from the entity chain of its scope - - function Subtype_Kind (K : Entity_Kind) return Entity_Kind; - -- Given an entity_kind K this function returns the entity_kind - -- corresponding to subtype kind of the type represented by K. For - -- example if K is E_Signed_Integer_Type then E_Signed_Integer_Subtype - -- is returned. If K is already a subtype kind it itself is returned. An - -- internal error is generated if no such correspondence exists for K. - - procedure Unlink_Next_Entity (Id : Entity_Id); - -- Unchain entity Id's forward link within the entity chain of its scope - - ---------------------------------- - -- Debugging Output Subprograms -- - ---------------------------------- - - procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String); - -- Writes a series of entries giving a line for each flag that is - -- set to True. Each line is prefixed by the given string. - - procedure Write_Entity_Info (Id : Entity_Id; Prefix : String); - -- A debugging procedure to write out information about an entity - - procedure Write_Field6_Name (Id : Entity_Id); - procedure Write_Field7_Name (Id : Entity_Id); - procedure Write_Field8_Name (Id : Entity_Id); - procedure Write_Field9_Name (Id : Entity_Id); - procedure Write_Field10_Name (Id : Entity_Id); - procedure Write_Field11_Name (Id : Entity_Id); - procedure Write_Field12_Name (Id : Entity_Id); - procedure Write_Field13_Name (Id : Entity_Id); - procedure Write_Field14_Name (Id : Entity_Id); - procedure Write_Field15_Name (Id : Entity_Id); - procedure Write_Field16_Name (Id : Entity_Id); - procedure Write_Field17_Name (Id : Entity_Id); - procedure Write_Field18_Name (Id : Entity_Id); - procedure Write_Field19_Name (Id : Entity_Id); - procedure Write_Field20_Name (Id : Entity_Id); - procedure Write_Field21_Name (Id : Entity_Id); - procedure Write_Field22_Name (Id : Entity_Id); - procedure Write_Field23_Name (Id : Entity_Id); - procedure Write_Field24_Name (Id : Entity_Id); - procedure Write_Field25_Name (Id : Entity_Id); - procedure Write_Field26_Name (Id : Entity_Id); - procedure Write_Field27_Name (Id : Entity_Id); - procedure Write_Field28_Name (Id : Entity_Id); - procedure Write_Field29_Name (Id : Entity_Id); - procedure Write_Field30_Name (Id : Entity_Id); - procedure Write_Field31_Name (Id : Entity_Id); - procedure Write_Field32_Name (Id : Entity_Id); - procedure Write_Field33_Name (Id : Entity_Id); - procedure Write_Field34_Name (Id : Entity_Id); - procedure Write_Field35_Name (Id : Entity_Id); - procedure Write_Field36_Name (Id : Entity_Id); - procedure Write_Field37_Name (Id : Entity_Id); - procedure Write_Field38_Name (Id : Entity_Id); - procedure Write_Field39_Name (Id : Entity_Id); - procedure Write_Field40_Name (Id : Entity_Id); - procedure Write_Field41_Name (Id : Entity_Id); - -- These routines are used in Treepr to output a nice symbolic name for - -- the given field, depending on the Ekind. No blanks or end of lines are - -- output, just the characters of the field name. - ---------------------------------- -- Inline Pragmas for functions -- ---------------------------------- @@ -8674,1127 +6434,6 @@ package Einfo is -- program in preparing the corresponding C header, and only those -- subprograms meeting the requirements documented in the section on -- XEINFO may be referenced in this section. - - pragma Inline (Abstract_States); - pragma Inline (Accept_Address); - pragma Inline (Access_Disp_Table); - pragma Inline (Access_Disp_Table_Elab_Flag); - pragma Inline (Access_Subprogram_Wrapper); - pragma Inline (Activation_Record_Component); - pragma Inline (Actual_Subtype); - pragma Inline (Address_Taken); - pragma Inline (Alias); - pragma Inline (Alignment); - pragma Inline (Anonymous_Designated_Type); - pragma Inline (Anonymous_Masters); - pragma Inline (Anonymous_Object); - pragma Inline (Associated_Entity); - pragma Inline (Associated_Formal_Package); - pragma Inline (Associated_Node_For_Itype); - pragma Inline (Associated_Storage_Pool); - pragma Inline (Barrier_Function); - pragma Inline (BIP_Initialization_Call); - pragma Inline (Block_Node); - pragma Inline (Body_Entity); - pragma Inline (Body_Needed_For_Inlining); - pragma Inline (Body_Needed_For_SAL); - pragma Inline (Body_References); - pragma Inline (C_Pass_By_Copy); - pragma Inline (Can_Never_Be_Null); - pragma Inline (Can_Use_Internal_Rep); - pragma Inline (Checks_May_Be_Suppressed); - pragma Inline (Class_Wide_Clone); - pragma Inline (Class_Wide_Type); - pragma Inline (Cloned_Subtype); - pragma Inline (Component_Bit_Offset); - pragma Inline (Component_Clause); - pragma Inline (Component_Size); - pragma Inline (Component_Type); - pragma Inline (Contains_Ignored_Ghost_Code); - pragma Inline (Contract); - pragma Inline (Contract_Wrapper); - pragma Inline (Corresponding_Concurrent_Type); - pragma Inline (Corresponding_Discriminant); - pragma Inline (Corresponding_Equality); - pragma Inline (Corresponding_Function); - pragma Inline (Corresponding_Procedure); - pragma Inline (Corresponding_Protected_Entry); - pragma Inline (Corresponding_Record_Component); - pragma Inline (Corresponding_Record_Type); - pragma Inline (Corresponding_Remote_Type); - pragma Inline (CR_Discriminant); - pragma Inline (Current_Use_Clause); - pragma Inline (Current_Value); - pragma Inline (Debug_Info_Off); - pragma Inline (Debug_Renaming_Link); - pragma Inline (Default_Aspect_Component_Value); - pragma Inline (Default_Aspect_Value); - pragma Inline (Default_Expr_Function); - pragma Inline (Default_Expressions_Processed); - pragma Inline (Default_Value); - pragma Inline (Delay_Cleanups); - pragma Inline (Delay_Subprogram_Descriptors); - pragma Inline (Delta_Value); - pragma Inline (Dependent_Instances); - pragma Inline (Depends_On_Private); - pragma Inline (Derived_Type_Link); - pragma Inline (Digits_Value); - pragma Inline (Direct_Primitive_Operations); - pragma Inline (Directly_Designated_Type); - pragma Inline (Disable_Controlled); - pragma Inline (Discard_Names); - pragma Inline (Discriminal); - pragma Inline (Discriminal_Link); - pragma Inline (Discriminant_Checking_Func); - pragma Inline (Discriminant_Constraint); - pragma Inline (Discriminant_Default_Value); - pragma Inline (Discriminant_Number); - pragma Inline (Dispatch_Table_Wrappers); - pragma Inline (DT_Entry_Count); - pragma Inline (DT_Offset_To_Top_Func); - pragma Inline (DT_Position); - pragma Inline (DTC_Entity); - pragma Inline (Elaborate_Body_Desirable); - pragma Inline (Elaboration_Entity); - pragma Inline (Elaboration_Entity_Required); - pragma Inline (Encapsulating_State); - pragma Inline (Enclosing_Scope); - pragma Inline (Entry_Accepted); - pragma Inline (Entry_Bodies_Array); - pragma Inline (Entry_Cancel_Parameter); - pragma Inline (Entry_Component); - pragma Inline (Entry_Formal); - pragma Inline (Entry_Index_Constant); - pragma Inline (Entry_Index_Type); - pragma Inline (Entry_Max_Queue_Lengths_Array); - pragma Inline (Entry_Parameters_Type); - pragma Inline (Enum_Pos_To_Rep); - pragma Inline (Enumeration_Pos); - pragma Inline (Enumeration_Rep); - pragma Inline (Enumeration_Rep_Expr); - pragma Inline (Equivalent_Type); - pragma Inline (Esize); - pragma Inline (Extra_Accessibility); - pragma Inline (Extra_Accessibility_Of_Result); - pragma Inline (Extra_Constrained); - pragma Inline (Extra_Formal); - pragma Inline (Extra_Formals); - pragma Inline (Finalize_Storage_Only); - pragma Inline (Finalization_Master); - pragma Inline (Finalizer); - pragma Inline (First_Entity); - pragma Inline (First_Exit_Statement); - pragma Inline (First_Index); - pragma Inline (First_Literal); - pragma Inline (First_Private_Entity); - pragma Inline (First_Rep_Item); - pragma Inline (Freeze_Node); - pragma Inline (From_Limited_With); - pragma Inline (Full_View); - pragma Inline (Generic_Homonym); - pragma Inline (Generic_Renamings); - pragma Inline (Handler_Records); - pragma Inline (Has_Aliased_Components); - pragma Inline (Has_Alignment_Clause); - pragma Inline (Has_All_Calls_Remote); - pragma Inline (Has_Atomic_Components); - pragma Inline (Has_Biased_Representation); - pragma Inline (Has_Completion); - pragma Inline (Has_Completion_In_Body); - pragma Inline (Has_Complex_Representation); - pragma Inline (Has_Component_Size_Clause); - pragma Inline (Has_Constrained_Partial_View); - pragma Inline (Has_Contiguous_Rep); - pragma Inline (Has_Controlled_Component); - pragma Inline (Has_Controlling_Result); - pragma Inline (Has_Convention_Pragma); - pragma Inline (Has_Default_Aspect); - pragma Inline (Has_Delayed_Aspects); - pragma Inline (Has_Delayed_Freeze); - pragma Inline (Has_Delayed_Rep_Aspects); - pragma Inline (Has_DIC); - pragma Inline (Has_Discriminants); - pragma Inline (Has_Dispatch_Table); - pragma Inline (Has_Dynamic_Predicate_Aspect); - pragma Inline (Has_Enumeration_Rep_Clause); - pragma Inline (Has_Exit); - pragma Inline (Has_Expanded_Contract); - pragma Inline (Has_Forward_Instantiation); - pragma Inline (Has_Fully_Qualified_Name); - pragma Inline (Has_Gigi_Rep_Item); - pragma Inline (Has_Homonym); - pragma Inline (Has_Implicit_Dereference); - pragma Inline (Has_Independent_Components); - pragma Inline (Has_Inheritable_Invariants); - pragma Inline (Has_Inherited_DIC); - pragma Inline (Has_Inherited_Invariants); - pragma Inline (Has_Initial_Value); - pragma Inline (Has_Invariants); - pragma Inline (Has_Loop_Entry_Attributes); - pragma Inline (Has_Machine_Radix_Clause); - pragma Inline (Has_Master_Entity); - pragma Inline (Has_Missing_Return); - pragma Inline (Has_Nested_Block_With_Handler); - pragma Inline (Has_Nested_Subprogram); - pragma Inline (Has_Non_Standard_Rep); - pragma Inline (Has_Object_Size_Clause); - pragma Inline (Has_Out_Or_In_Out_Parameter); - pragma Inline (Has_Own_DIC); - pragma Inline (Has_Own_Invariants); - pragma Inline (Has_Partial_Visible_Refinement); - pragma Inline (Has_Per_Object_Constraint); - pragma Inline (Has_Pragma_Controlled); - pragma Inline (Has_Pragma_Elaborate_Body); - pragma Inline (Has_Pragma_Inline); - pragma Inline (Has_Pragma_Inline_Always); - pragma Inline (Has_Pragma_No_Inline); - pragma Inline (Has_Pragma_Ordered); - pragma Inline (Has_Pragma_Pack); - pragma Inline (Has_Pragma_Preelab_Init); - pragma Inline (Has_Pragma_Pure); - pragma Inline (Has_Pragma_Pure_Function); - pragma Inline (Has_Pragma_Thread_Local_Storage); - pragma Inline (Has_Pragma_Unmodified); - pragma Inline (Has_Pragma_Unreferenced); - pragma Inline (Has_Pragma_Unreferenced_Objects); - pragma Inline (Has_Pragma_Unused); - pragma Inline (Has_Predicates); - pragma Inline (Has_Primitive_Operations); - pragma Inline (Has_Private_Ancestor); - pragma Inline (Has_Private_Declaration); - pragma Inline (Has_Private_Extension); - pragma Inline (Has_Protected); - pragma Inline (Has_Qualified_Name); - pragma Inline (Has_RACW); - pragma Inline (Has_Record_Rep_Clause); - pragma Inline (Has_Recursive_Call); - pragma Inline (Has_Shift_Operator); - pragma Inline (Has_Size_Clause); - pragma Inline (Has_Small_Clause); - pragma Inline (Has_Specified_Layout); - pragma Inline (Has_Specified_Stream_Input); - pragma Inline (Has_Specified_Stream_Output); - pragma Inline (Has_Specified_Stream_Read); - pragma Inline (Has_Specified_Stream_Write); - pragma Inline (Has_Static_Discriminants); - pragma Inline (Has_Static_Predicate); - pragma Inline (Has_Static_Predicate_Aspect); - pragma Inline (Has_Storage_Size_Clause); - pragma Inline (Has_Stream_Size_Clause); - pragma Inline (Has_Task); - pragma Inline (Has_Timing_Event); - pragma Inline (Has_Thunks); - pragma Inline (Has_Unchecked_Union); - pragma Inline (Has_Unknown_Discriminants); - pragma Inline (Has_Visible_Refinement); - pragma Inline (Has_Volatile_Components); - pragma Inline (Has_Xref_Entry); - pragma Inline (Has_Yield_Aspect); - pragma Inline (Hiding_Loop_Variable); - pragma Inline (Hidden_In_Formal_Instance); - pragma Inline (Homonym); - pragma Inline (Ignore_SPARK_Mode_Pragmas); - pragma Inline (Import_Pragma); - pragma Inline (Incomplete_Actuals); - pragma Inline (In_Package_Body); - pragma Inline (In_Private_Part); - pragma Inline (In_Use); - pragma Inline (Initialization_Statements); - pragma Inline (Inner_Instances); - pragma Inline (Interface_Alias); - pragma Inline (Interface_Name); - pragma Inline (Interfaces); - pragma Inline (Is_Abstract_Subprogram); - pragma Inline (Is_Abstract_Type); - pragma Inline (Is_Access_Constant); - pragma Inline (Is_Activation_Record); - pragma Inline (Is_Actual_Subtype); - pragma Inline (Is_Access_Protected_Subprogram_Type); - pragma Inline (Is_Access_Subprogram_Type); - pragma Inline (Is_Access_Type); - pragma Inline (Is_Ada_2005_Only); - pragma Inline (Is_Ada_2012_Only); - pragma Inline (Is_Aggregate_Type); - pragma Inline (Is_Aliased); - pragma Inline (Is_Anonymous_Access_Type); - pragma Inline (Is_Array_Type); - pragma Inline (Is_Assignable); - pragma Inline (Is_Asynchronous); - pragma Inline (Is_Atomic); - pragma Inline (Is_Bit_Packed_Array); - pragma Inline (Is_Called); - pragma Inline (Is_Character_Type); - pragma Inline (Is_Checked_Ghost_Entity); - pragma Inline (Is_Child_Unit); - pragma Inline (Is_Class_Wide_Clone); - pragma Inline (Is_Class_Wide_Equivalent_Type); - pragma Inline (Is_Class_Wide_Type); - pragma Inline (Is_Compilation_Unit); - pragma Inline (Is_Completely_Hidden); - pragma Inline (Is_Composite_Type); - pragma Inline (Is_Concurrent_Body); - pragma Inline (Is_Concurrent_Record_Type); - pragma Inline (Is_Concurrent_Type); - pragma Inline (Is_Constr_Subt_For_U_Nominal); - pragma Inline (Is_Constr_Subt_For_UN_Aliased); - pragma Inline (Is_Constrained); - pragma Inline (Is_Constructor); - pragma Inline (Is_Controlled_Active); - pragma Inline (Is_Controlling_Formal); - pragma Inline (Is_CPP_Class); - pragma Inline (Is_CUDA_Kernel); - pragma Inline (Is_Decimal_Fixed_Point_Type); - pragma Inline (Is_Descendant_Of_Address); - pragma Inline (Is_DIC_Procedure); - pragma Inline (Is_Digits_Type); - pragma Inline (Is_Discrete_Or_Fixed_Point_Type); - pragma Inline (Is_Discrete_Type); - pragma Inline (Is_Discrim_SO_Function); - pragma Inline (Is_Discriminant_Check_Function); - pragma Inline (Is_Dispatch_Table_Entity); - pragma Inline (Is_Dispatching_Operation); - pragma Inline (Is_Elaboration_Checks_OK_Id); - pragma Inline (Is_Elaboration_Warnings_OK_Id); - pragma Inline (Is_Elementary_Type); - pragma Inline (Is_Eliminated); - pragma Inline (Is_Entry); - pragma Inline (Is_Entry_Formal); - pragma Inline (Is_Entry_Wrapper); - pragma Inline (Is_Enumeration_Type); - pragma Inline (Is_Exception_Handler); - pragma Inline (Is_Exported); - pragma Inline (Is_Finalized_Transient); - pragma Inline (Is_First_Subtype); - pragma Inline (Is_Fixed_Point_Type); - pragma Inline (Is_Floating_Point_Type); - pragma Inline (Is_Formal); - pragma Inline (Is_Formal_Object); - pragma Inline (Is_Formal_Subprogram); - pragma Inline (Is_Frozen); - pragma Inline (Is_Full_Access); - pragma Inline (Is_Generic_Actual_Subprogram); - pragma Inline (Is_Generic_Actual_Type); - pragma Inline (Is_Generic_Instance); - pragma Inline (Is_Generic_Subprogram); - pragma Inline (Is_Generic_Type); - pragma Inline (Is_Generic_Unit); - pragma Inline (Is_Ghost_Entity); - pragma Inline (Is_Hidden); - pragma Inline (Is_Hidden_Non_Overridden_Subpgm); - pragma Inline (Is_Hidden_Open_Scope); - pragma Inline (Is_Ignored_Ghost_Entity); - pragma Inline (Is_Ignored_Transient); - pragma Inline (Is_Immediately_Visible); - pragma Inline (Is_Implementation_Defined); - pragma Inline (Is_Imported); - pragma Inline (Is_Incomplete_Or_Private_Type); - pragma Inline (Is_Incomplete_Type); - pragma Inline (Is_Independent); - pragma Inline (Is_Initial_Condition_Procedure); - pragma Inline (Is_Inlined); - pragma Inline (Is_Inlined_Always); - pragma Inline (Is_Instantiated); - pragma Inline (Is_Integer_Type); - pragma Inline (Is_Interface); - pragma Inline (Is_Internal); - pragma Inline (Is_Interrupt_Handler); - pragma Inline (Is_Intrinsic_Subprogram); - pragma Inline (Is_Invariant_Procedure); - pragma Inline (Is_Itype); - pragma Inline (Is_Known_Non_Null); - pragma Inline (Is_Known_Null); - pragma Inline (Is_Known_Valid); - pragma Inline (Is_Limited_Composite); - pragma Inline (Is_Limited_Interface); - pragma Inline (Is_Limited_Record); - pragma Inline (Is_Local_Anonymous_Access); - pragma Inline (Is_Loop_Parameter); - pragma Inline (Is_Machine_Code_Subprogram); - pragma Inline (Is_Modular_Integer_Type); - pragma Inline (Is_Named_Number); - pragma Inline (Is_Non_Static_Subtype); - pragma Inline (Is_Null_Init_Proc); - pragma Inline (Is_Numeric_Type); - pragma Inline (Is_Object); - pragma Inline (Is_Obsolescent); - pragma Inline (Is_Only_Out_Parameter); - pragma Inline (Is_Ordinary_Fixed_Point_Type); - pragma Inline (Is_Overloadable); - pragma Inline (Is_Package_Body_Entity); - pragma Inline (Is_Packed); - pragma Inline (Is_Packed_Array_Impl_Type); - pragma Inline (Is_Param_Block_Component_Type); - pragma Inline (Is_Partial_Invariant_Procedure); - pragma Inline (Is_Potentially_Use_Visible); - pragma Inline (Is_Predicate_Function); - pragma Inline (Is_Predicate_Function_M); - pragma Inline (Is_Preelaborated); - pragma Inline (Is_Primitive); - pragma Inline (Is_Primitive_Wrapper); - pragma Inline (Is_Private_Composite); - pragma Inline (Is_Private_Descendant); - pragma Inline (Is_Private_Primitive); - pragma Inline (Is_Private_Type); - pragma Inline (Is_Protected_Type); - pragma Inline (Is_Public); - pragma Inline (Is_Pure); - pragma Inline (Is_Pure_Unit_Access_Type); - pragma Inline (Is_RACW_Stub_Type); - pragma Inline (Is_Raised); - pragma Inline (Is_Real_Type); - pragma Inline (Is_Record_Type); - pragma Inline (Is_Remote_Call_Interface); - pragma Inline (Is_Remote_Types); - pragma Inline (Is_Renaming_Of_Object); - pragma Inline (Is_Return_Object); - pragma Inline (Is_Safe_To_Reevaluate); - pragma Inline (Is_Scalar_Type); - pragma Inline (Is_Shared_Passive); - pragma Inline (Is_Signed_Integer_Type); - pragma Inline (Is_Static_Type); - pragma Inline (Is_Statically_Allocated); - pragma Inline (Is_Subprogram); - pragma Inline (Is_Subprogram_Or_Entry); - pragma Inline (Is_Subprogram_Or_Generic_Subprogram); - pragma Inline (Is_Tag); - pragma Inline (Is_Tagged_Type); - pragma Inline (Is_Task_Type); - pragma Inline (Is_Thunk); - pragma Inline (Is_Trivial_Subprogram); - pragma Inline (Is_True_Constant); - pragma Inline (Is_Type); - pragma Inline (Is_Unchecked_Union); - pragma Inline (Is_Underlying_Full_View); - pragma Inline (Is_Underlying_Record_View); - pragma Inline (Is_Unimplemented); - pragma Inline (Is_Unsigned_Type); - pragma Inline (Is_Uplevel_Referenced_Entity); - pragma Inline (Is_Valued_Procedure); - pragma Inline (Is_Visible_Formal); - pragma Inline (Is_Visible_Lib_Unit); - pragma Inline (Is_Volatile_Full_Access); - pragma Inline (Itype_Printed); - pragma Inline (Kill_Elaboration_Checks); - pragma Inline (Kill_Range_Checks); - pragma Inline (Known_To_Have_Preelab_Init); - pragma Inline (Last_Aggregate_Assignment); - pragma Inline (Last_Assignment); - pragma Inline (Last_Entity); - pragma Inline (Limited_View); - pragma Inline (Link_Entities); - pragma Inline (Linker_Section_Pragma); - pragma Inline (Lit_Hash); - pragma Inline (Lit_Indexes); - pragma Inline (Lit_Strings); - pragma Inline (Low_Bound_Tested); - pragma Inline (Machine_Radix_10); - pragma Inline (Master_Id); - pragma Inline (Materialize_Entity); - pragma Inline (May_Inherit_Delayed_Rep_Aspects); - pragma Inline (Mechanism); - pragma Inline (Minimum_Accessibility); - pragma Inline (Modulus); - pragma Inline (Must_Be_On_Byte_Boundary); - pragma Inline (Must_Have_Preelab_Init); - pragma Inline (Needs_Activation_Record); - pragma Inline (Needs_Debug_Info); - pragma Inline (Needs_No_Actuals); - pragma Inline (Never_Set_In_Source); - pragma Inline (Next_Index); - pragma Inline (Next_Inlined_Subprogram); - pragma Inline (Next_Literal); - pragma Inline (Next_Stored_Discriminant); - pragma Inline (No_Dynamic_Predicate_On_Actual); - pragma Inline (No_Pool_Assigned); - pragma Inline (No_Predicate_On_Actual); - pragma Inline (No_Reordering); - pragma Inline (No_Return); - pragma Inline (No_Strict_Aliasing); - pragma Inline (No_Tagged_Streams_Pragma); - pragma Inline (Non_Binary_Modulus); - pragma Inline (Non_Limited_View); - pragma Inline (Nonzero_Is_True); - pragma Inline (Normalized_First_Bit); - pragma Inline (Normalized_Position); - pragma Inline (Normalized_Position_Max); - pragma Inline (OK_To_Rename); - pragma Inline (Optimize_Alignment_Space); - pragma Inline (Optimize_Alignment_Time); - pragma Inline (Original_Access_Type); - pragma Inline (Original_Array_Type); - pragma Inline (Original_Protected_Subprogram); - pragma Inline (Original_Record_Component); - pragma Inline (Overlays_Constant); - pragma Inline (Overridden_Operation); - pragma Inline (Package_Instantiation); - pragma Inline (Packed_Array_Impl_Type); - pragma Inline (Parameter_Mode); - pragma Inline (Parent_Subtype); - pragma Inline (Part_Of_Constituents); - pragma Inline (Part_Of_References); - pragma Inline (Partial_View_Has_Unknown_Discr); - pragma Inline (Pending_Access_Types); - pragma Inline (Postconditions_Proc); - pragma Inline (Predicated_Parent); - pragma Inline (Predicates_Ignored); - pragma Inline (Prev_Entity); - pragma Inline (Prival); - pragma Inline (Prival_Link); - pragma Inline (Private_Dependents); - pragma Inline (Protected_Body_Subprogram); - pragma Inline (Protected_Formal); - pragma Inline (Protected_Subprogram); - pragma Inline (Protection_Object); - pragma Inline (Reachable); - pragma Inline (Receiving_Entry); - pragma Inline (Referenced); - pragma Inline (Referenced_As_LHS); - pragma Inline (Referenced_As_Out_Parameter); - pragma Inline (Refinement_Constituents); - pragma Inline (Register_Exception_Call); - pragma Inline (Related_Array_Object); - pragma Inline (Related_Expression); - pragma Inline (Related_Instance); - pragma Inline (Related_Type); - pragma Inline (Relative_Deadline_Variable); - pragma Inline (Remove_Entity); - pragma Inline (Renamed_Entity); - pragma Inline (Renamed_In_Spec); - pragma Inline (Renamed_Object); - pragma Inline (Renaming_Map); - pragma Inline (Requires_Overriding); - pragma Inline (Return_Applies_To); - pragma Inline (Return_Present); - pragma Inline (Returns_By_Ref); - pragma Inline (Reverse_Bit_Order); - pragma Inline (Reverse_Storage_Order); - pragma Inline (Rewritten_For_C); - pragma Inline (RM_Size); - pragma Inline (Scalar_Range); - pragma Inline (Scale_Value); - pragma Inline (Scope_Depth_Value); - pragma Inline (Sec_Stack_Needed_For_Return); - pragma Inline (Shared_Var_Procs_Instance); - pragma Inline (Size_Check_Code); - pragma Inline (Size_Depends_On_Discriminant); - pragma Inline (Size_Known_At_Compile_Time); - pragma Inline (Small_Value); - pragma Inline (SPARK_Aux_Pragma); - pragma Inline (SPARK_Aux_Pragma_Inherited); - pragma Inline (SPARK_Pragma); - pragma Inline (SPARK_Pragma_Inherited); - pragma Inline (Spec_Entity); - pragma Inline (SSO_Set_High_By_Default); - pragma Inline (SSO_Set_Low_By_Default); - pragma Inline (Static_Discrete_Predicate); - pragma Inline (Static_Elaboration_Desired); - pragma Inline (Static_Initialization); - pragma Inline (Static_Real_Or_String_Predicate); - pragma Inline (Status_Flag_Or_Transient_Decl); - pragma Inline (Storage_Size_Variable); - pragma Inline (Stored_Constraint); - pragma Inline (Stores_Attribute_Old_Prefix); - pragma Inline (Strict_Alignment); - pragma Inline (String_Literal_Length); - pragma Inline (String_Literal_Low_Bound); - pragma Inline (Subprograms_For_Type); - pragma Inline (Subps_Index); - pragma Inline (Suppress_Elaboration_Warnings); - pragma Inline (Suppress_Initialization); - pragma Inline (Suppress_Style_Checks); - pragma Inline (Suppress_Value_Tracking_On_Call); - pragma Inline (Task_Body_Procedure); - pragma Inline (Thunk_Entity); - pragma Inline (Treat_As_Volatile); - pragma Inline (Underlying_Full_View); - pragma Inline (Underlying_Record_View); - pragma Inline (Universal_Aliasing); - pragma Inline (Unlink_Next_Entity); - pragma Inline (Unset_Reference); - pragma Inline (Used_As_Generic_Actual); - pragma Inline (Uses_Lock_Free); - pragma Inline (Uses_Sec_Stack); - pragma Inline (Validated_Object); - pragma Inline (Warnings_Off); - pragma Inline (Warnings_Off_Used); - pragma Inline (Warnings_Off_Used_Unmodified); - pragma Inline (Warnings_Off_Used_Unreferenced); - pragma Inline (Was_Hidden); - pragma Inline (Wrapped_Entity); - - -- END XEINFO INLINES - - -- The following Inline pragmas are *not* read by XEINFO when building the - -- C version of this interface automatically (so the C version will end up - -- making out of line calls). The pragma scan in XEINFO will be terminated - -- on encountering the END XEINFO INLINES line. We inline things here which - -- are small, but not of the canonical attribute access/set format that can - -- be handled by XEINFO. - - pragma Inline (Address_Clause); - pragma Inline (Alignment_Clause); - pragma Inline (Base_Type); - pragma Inline (Float_Rep); - pragma Inline (Has_Foreign_Convention); - pragma Inline (Has_Limited_View); - pragma Inline (Has_Non_Limited_View); - pragma Inline (Is_Base_Type); - pragma Inline (Is_Boolean_Type); - pragma Inline (Is_Constant_Object); - pragma Inline (Is_Controlled); - pragma Inline (Is_Discriminal); - pragma Inline (Is_Entity_Name); - pragma Inline (Is_Finalizer); - pragma Inline (Is_Null_State); - pragma Inline (Is_Package_Or_Generic_Package); - pragma Inline (Is_Packed_Array); - pragma Inline (Is_Prival); - pragma Inline (Is_Protected_Component); - pragma Inline (Is_Protected_Record_Type); - pragma Inline (Is_String_Type); - pragma Inline (Is_Task_Record_Type); - pragma Inline (Is_Volatile); - pragma Inline (Is_Wrapper_Package); - pragma Inline (Scope_Depth); - pragma Inline (Scope_Depth_Set); - pragma Inline (Size_Clause); - pragma Inline (Stream_Size_Clause); - pragma Inline (Type_High_Bound); - pragma Inline (Type_Low_Bound); - - pragma Inline (Known_Alignment); - pragma Inline (Known_Component_Bit_Offset); - pragma Inline (Known_Component_Size); - pragma Inline (Known_Esize); - pragma Inline (Known_Normalized_First_Bit); - pragma Inline (Known_Normalized_Position); - pragma Inline (Known_Normalized_Position_Max); - pragma Inline (Known_RM_Size); - - pragma Inline (Known_Static_Component_Bit_Offset); - pragma Inline (Known_Static_Component_Size); - pragma Inline (Known_Static_Esize); - pragma Inline (Known_Static_Normalized_First_Bit); - pragma Inline (Known_Static_Normalized_Position); - pragma Inline (Known_Static_Normalized_Position_Max); - pragma Inline (Known_Static_RM_Size); - - pragma Inline (Unknown_Alignment); - pragma Inline (Unknown_Component_Bit_Offset); - pragma Inline (Unknown_Component_Size); - pragma Inline (Unknown_Esize); - pragma Inline (Unknown_Normalized_First_Bit); - pragma Inline (Unknown_Normalized_Position); - pragma Inline (Unknown_Normalized_Position_Max); - pragma Inline (Unknown_RM_Size); - - ----------------------------------- - -- Inline Pragmas for procedures -- - ----------------------------------- - - -- The following inline pragmas are *not* referenced by the XEINFO utility - -- program in preparing the corresponding C header, and therefore do *not* - -- need to meet the requirements documented in the section on XEINFO. - - pragma Inline (Set_Abstract_States); - pragma Inline (Set_Accept_Address); - pragma Inline (Set_Access_Disp_Table); - pragma Inline (Set_Access_Disp_Table_Elab_Flag); - pragma Inline (Set_Access_Subprogram_Wrapper); - pragma Inline (Set_Activation_Record_Component); - pragma Inline (Set_Actual_Subtype); - pragma Inline (Set_Address_Taken); - pragma Inline (Set_Alias); - pragma Inline (Set_Alignment); - pragma Inline (Set_Anonymous_Designated_Type); - pragma Inline (Set_Anonymous_Masters); - pragma Inline (Set_Anonymous_Object); - pragma Inline (Set_Associated_Entity); - pragma Inline (Set_Associated_Formal_Package); - pragma Inline (Set_Associated_Node_For_Itype); - pragma Inline (Set_Associated_Storage_Pool); - pragma Inline (Set_Barrier_Function); - pragma Inline (Set_BIP_Initialization_Call); - pragma Inline (Set_Block_Node); - pragma Inline (Set_Body_Entity); - pragma Inline (Set_Body_Needed_For_Inlining); - pragma Inline (Set_Body_Needed_For_SAL); - pragma Inline (Set_Body_References); - pragma Inline (Set_C_Pass_By_Copy); - pragma Inline (Set_Can_Never_Be_Null); - pragma Inline (Set_Can_Use_Internal_Rep); - pragma Inline (Set_Checks_May_Be_Suppressed); - pragma Inline (Set_Class_Wide_Clone); - pragma Inline (Set_Class_Wide_Type); - pragma Inline (Set_Cloned_Subtype); - pragma Inline (Set_Component_Bit_Offset); - pragma Inline (Set_Component_Clause); - pragma Inline (Set_Component_Size); - pragma Inline (Set_Component_Type); - pragma Inline (Set_Contains_Ignored_Ghost_Code); - pragma Inline (Set_Contract); - pragma Inline (Set_Contract_Wrapper); - pragma Inline (Set_Corresponding_Concurrent_Type); - pragma Inline (Set_Corresponding_Discriminant); - pragma Inline (Set_Corresponding_Equality); - pragma Inline (Set_Corresponding_Function); - pragma Inline (Set_Corresponding_Procedure); - pragma Inline (Set_Corresponding_Protected_Entry); - pragma Inline (Set_Corresponding_Record_Component); - pragma Inline (Set_Corresponding_Record_Type); - pragma Inline (Set_Corresponding_Remote_Type); - pragma Inline (Set_CR_Discriminant); - pragma Inline (Set_Current_Use_Clause); - pragma Inline (Set_Current_Value); - pragma Inline (Set_Debug_Info_Off); - pragma Inline (Set_Debug_Renaming_Link); - pragma Inline (Set_Default_Aspect_Component_Value); - pragma Inline (Set_Default_Aspect_Value); - pragma Inline (Set_Default_Expr_Function); - pragma Inline (Set_Default_Expressions_Processed); - pragma Inline (Set_Default_Value); - pragma Inline (Set_Delay_Cleanups); - pragma Inline (Set_Delay_Subprogram_Descriptors); - pragma Inline (Set_Delta_Value); - pragma Inline (Set_Dependent_Instances); - pragma Inline (Set_Depends_On_Private); - pragma Inline (Set_Derived_Type_Link); - pragma Inline (Set_Digits_Value); - pragma Inline (Set_Direct_Primitive_Operations); - pragma Inline (Set_Directly_Designated_Type); - pragma Inline (Set_Disable_Controlled); - pragma Inline (Set_Discard_Names); - pragma Inline (Set_Discriminal); - pragma Inline (Set_Discriminal_Link); - pragma Inline (Set_Discriminant_Checking_Func); - pragma Inline (Set_Discriminant_Constraint); - pragma Inline (Set_Discriminant_Default_Value); - pragma Inline (Set_Discriminant_Number); - pragma Inline (Set_Dispatch_Table_Wrappers); - pragma Inline (Set_DT_Entry_Count); - pragma Inline (Set_DT_Offset_To_Top_Func); - pragma Inline (Set_DT_Position); - pragma Inline (Set_DTC_Entity); - pragma Inline (Set_Elaborate_Body_Desirable); - pragma Inline (Set_Elaboration_Entity); - pragma Inline (Set_Elaboration_Entity_Required); - pragma Inline (Set_Encapsulating_State); - pragma Inline (Set_Enclosing_Scope); - pragma Inline (Set_Entry_Accepted); - pragma Inline (Set_Entry_Bodies_Array); - pragma Inline (Set_Entry_Cancel_Parameter); - pragma Inline (Set_Entry_Component); - pragma Inline (Set_Entry_Formal); - pragma Inline (Set_Entry_Max_Queue_Lengths_Array); - pragma Inline (Set_Entry_Parameters_Type); - pragma Inline (Set_Enum_Pos_To_Rep); - pragma Inline (Set_Enumeration_Pos); - pragma Inline (Set_Enumeration_Rep); - pragma Inline (Set_Enumeration_Rep_Expr); - pragma Inline (Set_Equivalent_Type); - pragma Inline (Set_Esize); - pragma Inline (Set_Extra_Accessibility); - pragma Inline (Set_Extra_Accessibility_Of_Result); - pragma Inline (Set_Extra_Constrained); - pragma Inline (Set_Extra_Formal); - pragma Inline (Set_Extra_Formals); - pragma Inline (Set_Finalize_Storage_Only); - pragma Inline (Set_Finalization_Master); - pragma Inline (Set_Finalizer); - pragma Inline (Set_First_Entity); - pragma Inline (Set_First_Exit_Statement); - pragma Inline (Set_First_Index); - pragma Inline (Set_First_Literal); - pragma Inline (Set_First_Private_Entity); - pragma Inline (Set_First_Rep_Item); - pragma Inline (Set_Float_Rep); - pragma Inline (Set_Freeze_Node); - pragma Inline (Set_From_Limited_With); - pragma Inline (Set_Full_View); - pragma Inline (Set_Generic_Homonym); - pragma Inline (Set_Generic_Renamings); - pragma Inline (Set_Handler_Records); - pragma Inline (Set_Has_Aliased_Components); - pragma Inline (Set_Has_Alignment_Clause); - pragma Inline (Set_Has_All_Calls_Remote); - pragma Inline (Set_Has_Atomic_Components); - pragma Inline (Set_Has_Biased_Representation); - pragma Inline (Set_Has_Completion); - pragma Inline (Set_Has_Completion_In_Body); - pragma Inline (Set_Has_Complex_Representation); - pragma Inline (Set_Has_Component_Size_Clause); - pragma Inline (Set_Has_Constrained_Partial_View); - pragma Inline (Set_Has_Contiguous_Rep); - pragma Inline (Set_Has_Controlled_Component); - pragma Inline (Set_Has_Controlling_Result); - pragma Inline (Set_Has_Convention_Pragma); - pragma Inline (Set_Has_Default_Aspect); - pragma Inline (Set_Has_Delayed_Aspects); - pragma Inline (Set_Has_Delayed_Freeze); - pragma Inline (Set_Has_Delayed_Rep_Aspects); - pragma Inline (Set_Has_Discriminants); - pragma Inline (Set_Has_Dispatch_Table); - pragma Inline (Set_Has_Dynamic_Predicate_Aspect); - pragma Inline (Set_Has_Enumeration_Rep_Clause); - pragma Inline (Set_Has_Exit); - pragma Inline (Set_Has_Expanded_Contract); - pragma Inline (Set_Has_Forward_Instantiation); - pragma Inline (Set_Has_Fully_Qualified_Name); - pragma Inline (Set_Has_Gigi_Rep_Item); - pragma Inline (Set_Has_Homonym); - pragma Inline (Set_Has_Implicit_Dereference); - pragma Inline (Set_Has_Independent_Components); - pragma Inline (Set_Has_Inheritable_Invariants); - pragma Inline (Set_Has_Inherited_DIC); - pragma Inline (Set_Has_Inherited_Invariants); - pragma Inline (Set_Has_Initial_Value); - pragma Inline (Set_Has_Loop_Entry_Attributes); - pragma Inline (Set_Has_Machine_Radix_Clause); - pragma Inline (Set_Has_Master_Entity); - pragma Inline (Set_Has_Missing_Return); - pragma Inline (Set_Has_Nested_Block_With_Handler); - pragma Inline (Set_Has_Nested_Subprogram); - pragma Inline (Set_Has_Non_Standard_Rep); - pragma Inline (Set_Has_Object_Size_Clause); - pragma Inline (Set_Has_Out_Or_In_Out_Parameter); - pragma Inline (Set_Has_Own_DIC); - pragma Inline (Set_Has_Own_Invariants); - pragma Inline (Set_Has_Partial_Visible_Refinement); - pragma Inline (Set_Has_Per_Object_Constraint); - pragma Inline (Set_Has_Pragma_Controlled); - pragma Inline (Set_Has_Pragma_Elaborate_Body); - pragma Inline (Set_Has_Pragma_Inline); - pragma Inline (Set_Has_Pragma_Inline_Always); - pragma Inline (Set_Has_Pragma_No_Inline); - pragma Inline (Set_Has_Pragma_Ordered); - pragma Inline (Set_Has_Pragma_Pack); - pragma Inline (Set_Has_Pragma_Preelab_Init); - pragma Inline (Set_Has_Pragma_Pure); - pragma Inline (Set_Has_Pragma_Pure_Function); - pragma Inline (Set_Has_Pragma_Thread_Local_Storage); - pragma Inline (Set_Has_Pragma_Unmodified); - pragma Inline (Set_Has_Pragma_Unreferenced); - pragma Inline (Set_Has_Pragma_Unreferenced_Objects); - pragma Inline (Set_Has_Predicates); - pragma Inline (Set_Has_Primitive_Operations); - pragma Inline (Set_Has_Private_Ancestor); - pragma Inline (Set_Has_Private_Declaration); - pragma Inline (Set_Has_Private_Extension); - pragma Inline (Set_Has_Protected); - pragma Inline (Set_Has_Qualified_Name); - pragma Inline (Set_Has_RACW); - pragma Inline (Set_Has_Record_Rep_Clause); - pragma Inline (Set_Has_Recursive_Call); - pragma Inline (Set_Has_Shift_Operator); - pragma Inline (Set_Has_Size_Clause); - pragma Inline (Set_Has_Small_Clause); - pragma Inline (Set_Has_Specified_Layout); - pragma Inline (Set_Has_Specified_Stream_Input); - pragma Inline (Set_Has_Specified_Stream_Output); - pragma Inline (Set_Has_Specified_Stream_Read); - pragma Inline (Set_Has_Specified_Stream_Write); - pragma Inline (Set_Has_Static_Discriminants); - pragma Inline (Set_Has_Static_Predicate); - pragma Inline (Set_Has_Static_Predicate_Aspect); - pragma Inline (Set_Has_Storage_Size_Clause); - pragma Inline (Set_Has_Stream_Size_Clause); - pragma Inline (Set_Has_Task); - pragma Inline (Set_Has_Timing_Event); - pragma Inline (Set_Has_Thunks); - pragma Inline (Set_Has_Unchecked_Union); - pragma Inline (Set_Has_Unknown_Discriminants); - pragma Inline (Set_Has_Visible_Refinement); - pragma Inline (Set_Has_Volatile_Components); - pragma Inline (Set_Has_Xref_Entry); - pragma Inline (Set_Has_Yield_Aspect); - pragma Inline (Set_Hiding_Loop_Variable); - pragma Inline (Set_Hidden_In_Formal_Instance); - pragma Inline (Set_Homonym); - pragma Inline (Set_Ignore_SPARK_Mode_Pragmas); - pragma Inline (Set_Import_Pragma); - pragma Inline (Set_Incomplete_Actuals); - pragma Inline (Set_In_Package_Body); - pragma Inline (Set_In_Private_Part); - pragma Inline (Set_In_Use); - pragma Inline (Set_Initialization_Statements); - pragma Inline (Set_Inner_Instances); - pragma Inline (Set_Interface_Alias); - pragma Inline (Set_Interface_Name); - pragma Inline (Set_Interfaces); - pragma Inline (Set_Is_Abstract_Subprogram); - pragma Inline (Set_Is_Abstract_Type); - pragma Inline (Set_Is_Access_Constant); - pragma Inline (Set_Is_Activation_Record); - pragma Inline (Set_Is_Actual_Subtype); - pragma Inline (Set_Is_Ada_2005_Only); - pragma Inline (Set_Is_Ada_2012_Only); - pragma Inline (Set_Is_Aliased); - pragma Inline (Set_Is_Asynchronous); - pragma Inline (Set_Is_Atomic); - pragma Inline (Set_Is_Bit_Packed_Array); - pragma Inline (Set_Is_Called); - pragma Inline (Set_Is_Character_Type); - pragma Inline (Set_Is_Checked_Ghost_Entity); - pragma Inline (Set_Is_Child_Unit); - pragma Inline (Set_Is_Class_Wide_Clone); - pragma Inline (Set_Is_Class_Wide_Equivalent_Type); - pragma Inline (Set_Is_Compilation_Unit); - pragma Inline (Set_Is_Completely_Hidden); - pragma Inline (Set_Is_Concurrent_Record_Type); - pragma Inline (Set_Is_Constr_Subt_For_U_Nominal); - pragma Inline (Set_Is_Constr_Subt_For_UN_Aliased); - pragma Inline (Set_Is_Constrained); - pragma Inline (Set_Is_Constructor); - pragma Inline (Set_Is_Controlled_Active); - pragma Inline (Set_Is_Controlling_Formal); - pragma Inline (Set_Is_CPP_Class); - pragma Inline (Set_Is_CUDA_Kernel); - pragma Inline (Set_Is_Descendant_Of_Address); - pragma Inline (Set_Is_DIC_Procedure); - pragma Inline (Set_Is_Discrim_SO_Function); - pragma Inline (Set_Is_Discriminant_Check_Function); - pragma Inline (Set_Is_Dispatch_Table_Entity); - pragma Inline (Set_Is_Dispatching_Operation); - pragma Inline (Set_Is_Elaboration_Checks_OK_Id); - pragma Inline (Set_Is_Elaboration_Warnings_OK_Id); - pragma Inline (Set_Is_Eliminated); - pragma Inline (Set_Is_Entry_Formal); - pragma Inline (Set_Is_Entry_Wrapper); - pragma Inline (Set_Is_Exception_Handler); - pragma Inline (Set_Is_Exported); - pragma Inline (Set_Is_Finalized_Transient); - pragma Inline (Set_Is_First_Subtype); - pragma Inline (Set_Is_Formal_Subprogram); - pragma Inline (Set_Is_Frozen); - pragma Inline (Set_Is_Generic_Actual_Subprogram); - pragma Inline (Set_Is_Generic_Actual_Type); - pragma Inline (Set_Is_Generic_Instance); - pragma Inline (Set_Is_Generic_Type); - pragma Inline (Set_Is_Hidden); - pragma Inline (Set_Is_Hidden_Non_Overridden_Subpgm); - pragma Inline (Set_Is_Hidden_Open_Scope); - pragma Inline (Set_Is_Ignored_Ghost_Entity); - pragma Inline (Set_Is_Ignored_Transient); - pragma Inline (Set_Is_Immediately_Visible); - pragma Inline (Set_Is_Implementation_Defined); - pragma Inline (Set_Is_Imported); - pragma Inline (Set_Is_Independent); - pragma Inline (Set_Is_Initial_Condition_Procedure); - pragma Inline (Set_Is_Inlined); - pragma Inline (Set_Is_Inlined_Always); - pragma Inline (Set_Is_Instantiated); - pragma Inline (Set_Is_Interface); - pragma Inline (Set_Is_Internal); - pragma Inline (Set_Is_Interrupt_Handler); - pragma Inline (Set_Is_Intrinsic_Subprogram); - pragma Inline (Set_Is_Invariant_Procedure); - pragma Inline (Set_Is_Itype); - pragma Inline (Set_Is_Known_Non_Null); - pragma Inline (Set_Is_Known_Null); - pragma Inline (Set_Is_Known_Valid); - pragma Inline (Set_Is_Limited_Composite); - pragma Inline (Set_Is_Limited_Interface); - pragma Inline (Set_Is_Limited_Record); - pragma Inline (Set_Is_Local_Anonymous_Access); - pragma Inline (Set_Is_Loop_Parameter); - pragma Inline (Set_Is_Machine_Code_Subprogram); - pragma Inline (Set_Is_Non_Static_Subtype); - pragma Inline (Set_Is_Null_Init_Proc); - pragma Inline (Set_Is_Obsolescent); - pragma Inline (Set_Is_Only_Out_Parameter); - pragma Inline (Set_Is_Package_Body_Entity); - pragma Inline (Set_Is_Packed); - pragma Inline (Set_Is_Packed_Array_Impl_Type); - pragma Inline (Set_Is_Param_Block_Component_Type); - pragma Inline (Set_Is_Partial_Invariant_Procedure); - pragma Inline (Set_Is_Potentially_Use_Visible); - pragma Inline (Set_Is_Predicate_Function); - pragma Inline (Set_Is_Predicate_Function_M); - pragma Inline (Set_Is_Preelaborated); - pragma Inline (Set_Is_Primitive); - pragma Inline (Set_Is_Primitive_Wrapper); - pragma Inline (Set_Is_Private_Composite); - pragma Inline (Set_Is_Private_Descendant); - pragma Inline (Set_Is_Private_Primitive); - pragma Inline (Set_Is_Public); - pragma Inline (Set_Is_Pure); - pragma Inline (Set_Is_Pure_Unit_Access_Type); - pragma Inline (Set_Is_RACW_Stub_Type); - pragma Inline (Set_Is_Raised); - pragma Inline (Set_Is_Remote_Call_Interface); - pragma Inline (Set_Is_Remote_Types); - pragma Inline (Set_Is_Renaming_Of_Object); - pragma Inline (Set_Is_Return_Object); - pragma Inline (Set_Is_Safe_To_Reevaluate); - pragma Inline (Set_Is_Shared_Passive); - pragma Inline (Set_Is_Static_Type); - pragma Inline (Set_Is_Statically_Allocated); - pragma Inline (Set_Is_Tag); - pragma Inline (Set_Is_Tagged_Type); - pragma Inline (Set_Is_Thunk); - pragma Inline (Set_Is_Trivial_Subprogram); - pragma Inline (Set_Is_True_Constant); - pragma Inline (Set_Is_Unchecked_Union); - pragma Inline (Set_Is_Underlying_Full_View); - pragma Inline (Set_Is_Underlying_Record_View); - pragma Inline (Set_Is_Unimplemented); - pragma Inline (Set_Is_Unsigned_Type); - pragma Inline (Set_Is_Uplevel_Referenced_Entity); - pragma Inline (Set_Is_Valued_Procedure); - pragma Inline (Set_Is_Visible_Formal); - pragma Inline (Set_Is_Visible_Lib_Unit); - pragma Inline (Set_Is_Volatile); - pragma Inline (Set_Is_Volatile_Full_Access); - pragma Inline (Set_Itype_Printed); - pragma Inline (Set_Kill_Elaboration_Checks); - pragma Inline (Set_Kill_Range_Checks); - pragma Inline (Set_Known_To_Have_Preelab_Init); - pragma Inline (Set_Last_Aggregate_Assignment); - pragma Inline (Set_Last_Assignment); - pragma Inline (Set_Last_Entity); - pragma Inline (Set_Limited_View); - pragma Inline (Set_Linker_Section_Pragma); - pragma Inline (Set_Lit_Hash); - pragma Inline (Set_Lit_Indexes); - pragma Inline (Set_Lit_Strings); - pragma Inline (Set_Low_Bound_Tested); - pragma Inline (Set_Machine_Radix_10); - pragma Inline (Set_Master_Id); - pragma Inline (Set_Materialize_Entity); - pragma Inline (Set_May_Inherit_Delayed_Rep_Aspects); - pragma Inline (Set_Mechanism); - pragma Inline (Set_Minimum_Accessibility); - pragma Inline (Set_Modulus); - pragma Inline (Set_Must_Be_On_Byte_Boundary); - pragma Inline (Set_Must_Have_Preelab_Init); - pragma Inline (Set_Needs_Activation_Record); - pragma Inline (Set_Needs_Debug_Info); - pragma Inline (Set_Needs_No_Actuals); - pragma Inline (Set_Never_Set_In_Source); - pragma Inline (Set_Next_Inlined_Subprogram); - pragma Inline (Set_No_Dynamic_Predicate_On_Actual); - pragma Inline (Set_No_Pool_Assigned); - pragma Inline (Set_No_Predicate_On_Actual); - pragma Inline (Set_No_Reordering); - pragma Inline (Set_No_Return); - pragma Inline (Set_No_Strict_Aliasing); - pragma Inline (Set_No_Tagged_Streams_Pragma); - pragma Inline (Set_Non_Binary_Modulus); - pragma Inline (Set_Non_Limited_View); - pragma Inline (Set_Nonzero_Is_True); - pragma Inline (Set_Normalized_First_Bit); - pragma Inline (Set_Normalized_Position); - pragma Inline (Set_Normalized_Position_Max); - pragma Inline (Set_OK_To_Rename); - pragma Inline (Set_Optimize_Alignment_Space); - pragma Inline (Set_Optimize_Alignment_Time); - pragma Inline (Set_Original_Access_Type); - pragma Inline (Set_Original_Array_Type); - pragma Inline (Set_Original_Protected_Subprogram); - pragma Inline (Set_Original_Record_Component); - pragma Inline (Set_Overlays_Constant); - pragma Inline (Set_Overridden_Operation); - pragma Inline (Set_Package_Instantiation); - pragma Inline (Set_Packed_Array_Impl_Type); - pragma Inline (Set_Parent_Subtype); - pragma Inline (Set_Part_Of_Constituents); - pragma Inline (Set_Part_Of_References); - pragma Inline (Set_Partial_View_Has_Unknown_Discr); - pragma Inline (Set_Pending_Access_Types); - pragma Inline (Set_Postconditions_Proc); - pragma Inline (Set_Predicated_Parent); - pragma Inline (Set_Predicates_Ignored); - pragma Inline (Set_Prev_Entity); - pragma Inline (Set_Prival); - pragma Inline (Set_Prival_Link); - pragma Inline (Set_Private_Dependents); - pragma Inline (Set_Protected_Body_Subprogram); - pragma Inline (Set_Protected_Formal); - pragma Inline (Set_Protected_Subprogram); - pragma Inline (Set_Protection_Object); - pragma Inline (Set_Reachable); - pragma Inline (Set_Receiving_Entry); - pragma Inline (Set_Referenced); - pragma Inline (Set_Referenced_As_LHS); - pragma Inline (Set_Referenced_As_Out_Parameter); - pragma Inline (Set_Refinement_Constituents); - pragma Inline (Set_Register_Exception_Call); - pragma Inline (Set_Related_Array_Object); - pragma Inline (Set_Related_Expression); - pragma Inline (Set_Related_Instance); - pragma Inline (Set_Related_Type); - pragma Inline (Set_Relative_Deadline_Variable); - pragma Inline (Set_Renamed_Entity); - pragma Inline (Set_Renamed_In_Spec); - pragma Inline (Set_Renamed_Object); - pragma Inline (Set_Renaming_Map); - pragma Inline (Set_Requires_Overriding); - pragma Inline (Set_Return_Applies_To); - pragma Inline (Set_Return_Present); - pragma Inline (Set_Returns_By_Ref); - pragma Inline (Set_Reverse_Bit_Order); - pragma Inline (Set_Reverse_Storage_Order); - pragma Inline (Set_Rewritten_For_C); - pragma Inline (Set_RM_Size); - pragma Inline (Set_Scalar_Range); - pragma Inline (Set_Scale_Value); - pragma Inline (Set_Scope_Depth_Value); - pragma Inline (Set_Sec_Stack_Needed_For_Return); - pragma Inline (Set_Shared_Var_Procs_Instance); - pragma Inline (Set_Size_Check_Code); - pragma Inline (Set_Size_Depends_On_Discriminant); - pragma Inline (Set_Size_Known_At_Compile_Time); - pragma Inline (Set_Small_Value); - pragma Inline (Set_SPARK_Aux_Pragma); - pragma Inline (Set_SPARK_Aux_Pragma_Inherited); - pragma Inline (Set_SPARK_Pragma); - pragma Inline (Set_SPARK_Pragma_Inherited); - pragma Inline (Set_Spec_Entity); - pragma Inline (Set_SSO_Set_High_By_Default); - pragma Inline (Set_SSO_Set_Low_By_Default); - pragma Inline (Set_Static_Discrete_Predicate); - pragma Inline (Set_Static_Elaboration_Desired); - pragma Inline (Set_Static_Initialization); - pragma Inline (Set_Static_Real_Or_String_Predicate); - pragma Inline (Set_Status_Flag_Or_Transient_Decl); - pragma Inline (Set_Storage_Size_Variable); - pragma Inline (Set_Stored_Constraint); - pragma Inline (Set_Stores_Attribute_Old_Prefix); - pragma Inline (Set_Strict_Alignment); - pragma Inline (Set_String_Literal_Length); - pragma Inline (Set_String_Literal_Low_Bound); - pragma Inline (Set_Subprograms_For_Type); - pragma Inline (Set_Subps_Index); - pragma Inline (Set_Suppress_Elaboration_Warnings); - pragma Inline (Set_Suppress_Initialization); - pragma Inline (Set_Suppress_Style_Checks); - pragma Inline (Set_Suppress_Value_Tracking_On_Call); - pragma Inline (Set_Task_Body_Procedure); - pragma Inline (Set_Thunk_Entity); - pragma Inline (Set_Treat_As_Volatile); - pragma Inline (Set_Underlying_Full_View); - pragma Inline (Set_Underlying_Record_View); - pragma Inline (Set_Universal_Aliasing); - pragma Inline (Set_Unset_Reference); - pragma Inline (Set_Used_As_Generic_Actual); - pragma Inline (Set_Uses_Lock_Free); - pragma Inline (Set_Uses_Sec_Stack); - pragma Inline (Set_Validated_Object); - pragma Inline (Set_Warnings_Off); - pragma Inline (Set_Warnings_Off_Used); - pragma Inline (Set_Warnings_Off_Used_Unmodified); - pragma Inline (Set_Warnings_Off_Used_Unreferenced); - pragma Inline (Set_Was_Hidden); - pragma Inline (Set_Wrapped_Entity); - - pragma Inline (Init_Alignment); - pragma Inline (Init_Component_Bit_Offset); - pragma Inline (Init_Component_Size); - pragma Inline (Init_Digits_Value); - pragma Inline (Init_Esize); - pragma Inline (Init_Normalized_First_Bit); - pragma Inline (Init_Normalized_Position); - pragma Inline (Init_Normalized_Position_Max); - pragma Inline (Init_RM_Size); + -- ???? end Einfo; diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 855723add81..0ed58d49432 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -33,7 +33,9 @@ with Atree; use Atree; with Casing; use Casing; with Csets; use Csets; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Erroutc; use Erroutc; with Gnatvsn; use Gnatvsn; with Lib; use Lib; @@ -43,7 +45,9 @@ with Output; use Output; with Scans; use Scans; with Sem_Aux; use Sem_Aux; with Sinput; use Sinput; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stylesw; use Stylesw; @@ -4010,7 +4014,8 @@ package body Errout is -- other errors. The reason we eliminate unfrozen types is that -- messages issued before the freeze type are for sure OK. - elsif Is_Frozen (E) + elsif Nkind (N) in N_Entity + and then Is_Frozen (E) and then Serious_Errors_Detected > 0 and then Nkind (N) /= N_Component_Clause and then Nkind (Parent (N)) /= N_Component_Clause diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb index f6c08b0aa55..94f7ad6742a 100644 --- a/gcc/ada/eval_fat.adb +++ b/gcc/ada/eval_fat.adb @@ -23,7 +23,8 @@ -- -- ------------------------------------------------------------------------------ -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Opt; use Opt; with Sem_Util; use Sem_Util; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index f8168fe7758..531483762db 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; @@ -59,7 +61,9 @@ with Sem_Eval; use Sem_Eval; with Sem_Mech; use Sem_Mech; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb index 357474e7bb1..313da779490 100644 --- a/gcc/ada/exp_atag.adb +++ b/gcc/ada/exp_atag.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Disp; use Exp_Disp; with Namet; use Namet; @@ -32,7 +34,8 @@ with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Sem_Aux; use Sem_Aux; with Sem_Disp; use Sem_Disp; with Sem_Util; use Sem_Util; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 1775904a46b..9aecf6d0362 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -26,7 +26,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Atag; use Exp_Atag; with Exp_Ch3; use Exp_Ch3; @@ -59,7 +61,9 @@ with Sem_Ch8; use Sem_Ch8; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -7330,7 +7334,7 @@ package body Exp_Attr is P : Node_Id := Pref; begin - -- If the prefix has an entity, use the Esize from this entity + -- If the prefix is an object, use the Esize from this object -- to handle in a more user friendly way the case of objects -- or components with a large Size aspect: if a Size aspect is -- specified, we want to read a scalar value as large as the @@ -7343,6 +7347,7 @@ package body Exp_Attr is if Nkind (P) in N_Has_Entity and then Present (Entity (P)) + and then Is_Object (Entity (P)) and then Esize (Entity (P)) /= Uint_0 then if Esize (Entity (P)) <= System_Max_Integer_Size then diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb index 3e9c3d81cc2..7d7dd5bcd1d 100644 --- a/gcc/ada/exp_cg.adb +++ b/gcc/ada/exp_cg.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Dbug; use Exp_Dbug; with Exp_Tss; use Exp_Tss; @@ -36,7 +38,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Disp; use Sem_Disp; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with System; use System; @@ -376,7 +380,14 @@ package body Exp_CG is and then Nkind (Parent (Par)) /= N_Compilation_Unit loop Par := Parent (Par); - pragma Assert (Present (Par)); + + -- Par can legitimately be empty inside a class-wide + -- precondition; the "real" call will be found inside the + -- generated pragma. + + if No (Par) then + return; + end if; end loop; Set_Parent (Copy, Par); @@ -429,7 +440,7 @@ package body Exp_CG is procedure Write_Call_Info (Call : Node_Id) is Ctrl_Arg : constant Node_Id := Controlling_Argument (Call); Ctrl_Typ : constant Entity_Id := Base_Type (Etype (Ctrl_Arg)); - Prim : constant Entity_Id := Entity (Sinfo.Name (Call)); + Prim : constant Entity_Id := Entity (Sinfo.Nodes.Name (Call)); P : constant Node_Id := Parent (Call); begin @@ -559,13 +570,13 @@ package body Exp_CG is Write_Char ('"'); Write_Name (Chars (Parent_Typ)); - -- Note: Einfo prefix not needed if this routine is moved to + -- Note: Einfo.Entities prefix not needed if this routine is moved to -- exp_disp??? - if Present (Einfo.Interfaces (Typ)) - and then not Is_Empty_Elmt_List (Einfo.Interfaces (Typ)) + if Present (Einfo.Entities.Interfaces (Typ)) + and then not Is_Empty_Elmt_List (Einfo.Entities.Interfaces (Typ)) then - Elmt := First_Elmt (Einfo.Interfaces (Typ)); + Elmt := First_Elmt (Einfo.Entities.Interfaces (Typ)); while Present (Elmt) loop Write_Str (", "); Write_Name (Chars (Node (Elmt))); diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index c6a06aa0df3..5b9812242d5 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Ch7; use Exp_Ch7; @@ -42,7 +44,9 @@ with Sem; use Sem; with Sem_Ch8; use Sem_Ch8; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/exp_ch12.adb b/gcc/ada/exp_ch12.adb index 4b7d2ddbcfe..ce52b64aacd 100644 --- a/gcc/ada/exp_ch12.adb +++ b/gcc/ada/exp_ch12.adb @@ -25,10 +25,13 @@ with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with Exp_Util; use Exp_Util; with Nmake; use Nmake; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index 90316a8c732..efb43f0eb11 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Exp_Ch3; use Exp_Ch3; with Exp_Ch6; with Exp_Imgv; use Exp_Imgv; @@ -45,7 +47,9 @@ with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Tbuild; use Tbuild; with Uintp; use Uintp; diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index 6f80ca2d45e..30a9c73e2d2 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -26,7 +26,9 @@ with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Smem; use Exp_Smem; with Exp_Tss; use Exp_Tss; @@ -40,7 +42,9 @@ with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 6d7d178f35a..6843069a321 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -26,7 +26,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Exp_Aggr; use Exp_Aggr; with Exp_Atag; use Exp_Atag; @@ -66,7 +68,9 @@ with Sem_Res; use Sem_Res; with Sem_SCIL; use Sem_SCIL; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Stand; use Stand; with Snames; use Snames; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index cbc5aaf8091..1a12cf0200a 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -26,7 +26,9 @@ with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Aggr; use Exp_Aggr; @@ -61,7 +63,9 @@ with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with SCIL_LL; use SCIL_LL; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 64beef80dbd..9b403aff374 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Aggr; use Exp_Aggr; with Exp_Ch6; use Exp_Ch6; @@ -45,7 +47,9 @@ with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Ch3; use Sem_Ch3; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 52d468cd8c4..4471f35067d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -28,7 +28,9 @@ with Aspects; use Aspects; with Checks; use Checks; with Contracts; use Contracts; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Elists; use Elists; with Expander; use Expander; @@ -68,7 +70,9 @@ with Sem_Mech; use Sem_Mech; with Sem_Res; use Sem_Res; with Sem_SCIL; use Sem_SCIL; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; @@ -2209,7 +2213,7 @@ package body Exp_Ch6 is -- Check for volatility mismatch - if Is_Volatile_Object (Actual) and then not Is_Volatile (E_Formal) + if Is_Volatile_Object_Ref (Actual) and then not Is_Volatile (E_Formal) then if Comes_From_Source (N) then Error_Msg_N diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index d3c7ca7c585..2e0616977c4 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -30,7 +30,9 @@ with Atree; use Atree; with Contracts; use Contracts; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Ch6; use Exp_Ch6; @@ -52,7 +54,9 @@ with Output; use Output; with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Ch3; use Sem_Ch3; diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index ff617960a2b..554b5c84162 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Exp_Ch3; use Exp_Ch3; with Exp_Ch4; use Exp_Ch4; with Exp_Ch6; use Exp_Ch6; @@ -39,7 +41,9 @@ with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Ch8; use Sem_Ch8; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 825bf206639..356f11898e5 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -26,7 +26,9 @@ with Atree; use Atree; with Aspects; use Aspects; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Ch3; use Exp_Ch3; @@ -59,7 +61,9 @@ with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Targparm; use Targparm; diff --git a/gcc/ada/exp_code.adb b/gcc/ada/exp_code.adb index 3087d0677e8..9bfcd447d2f 100644 --- a/gcc/ada/exp_code.adb +++ b/gcc/ada/exp_code.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Lib; use Lib; with Namet; use Namet; @@ -36,7 +38,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Stringt; use Stringt; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 8a7536760e8..3cec36a0c46 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -26,7 +26,9 @@ with Alloc; with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Exp_Util; use Exp_Util; with Nlists; use Nlists; with Nmake; use Nmake; @@ -35,7 +37,9 @@ with Output; use Output; with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Stand; use Stand; with Stringt; use Stringt; with Table; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 18b691c5d7d..d7102f6b27a 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -26,7 +26,9 @@ with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; @@ -58,7 +60,9 @@ with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; @@ -4093,7 +4097,10 @@ package body Exp_Disp is Count := Count + 1; end loop; - pragma Assert (Related_Type (Node (Elmt)) = Typ); + -- Related_Type (Node (Elmt)) should be equal to Typ here, but we + -- can't assert that, because it is sometimes false in illegal + -- programs. We can't check Serious_Errors_Detected, because the + -- errors have not yet been detected. Get_External_Name (Node (Elmt)); Set_Interface_Name (DT, @@ -4694,8 +4701,8 @@ package body Exp_Disp is Discard_Names : constant Boolean := Present (No_Tagged_Streams_Pragma (Typ)) - and then (Global_Discard_Names - or else Einfo.Discard_Names (Typ)); + and then + (Global_Discard_Names or else Einfo.Entities.Discard_Names (Typ)); -- The following name entries are used by Make_DT to generate a number -- of entities related to a tagged type. These entities may be generated diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index d4f9b4eb190..1d1cd4c803a 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Atag; use Exp_Atag; with Exp_Strm; use Exp_Strm; @@ -44,7 +46,9 @@ with Sem_Ch12; use Sem_Ch12; with Sem_Dist; use Sem_Dist; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Stand; use Stand; with Stringt; use Stringt; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index 1621ba7f3d1..8d6da50c566 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Exp_Util; use Exp_Util; with Nlists; use Nlists; with Nmake; use Nmake; @@ -36,7 +38,8 @@ with Sem; use Sem; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Stand; use Stand; with Tbuild; use Tbuild; with Ttypes; use Ttypes; diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 74fde970ac8..b7ae3cd6a2a 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -26,8 +26,10 @@ with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Debug; use Debug; -with Einfo; use Einfo; with Exp_Put_Image; with Exp_Util; use Exp_Util; with Lib; use Lib; @@ -39,7 +41,9 @@ with Rtsfind; use Rtsfind; with Sem_Aux; use Sem_Aux; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index e2c3e343278..66f3f2c49a5 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Expander; use Expander; with Exp_Atag; use Exp_Atag; @@ -48,7 +50,9 @@ with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 1dc6af9a4c3..e3872d5187d 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Exp_Dbug; use Exp_Dbug; with Exp_Util; use Exp_Util; @@ -43,7 +45,9 @@ with Sem_Ch13; use Sem_Ch13; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Targparm; use Targparm; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 454b4c6cc58..11b80cd93dd 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -27,7 +27,9 @@ with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Ch11; use Exp_Ch11; @@ -47,7 +49,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Ch8; use Sem_Ch8; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stringt; use Stringt; diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 95fe1642e65..7793f1b89fd 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Exp_Tss; use Exp_Tss; with Exp_Util; with Debug; use Debug; @@ -36,7 +38,9 @@ with Opt; use Opt; with Rtsfind; use Rtsfind; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_sel.adb b/gcc/ada/exp_sel.adb index f17a80ece70..3abcc4decd2 100644 --- a/gcc/ada/exp_sel.adb +++ b/gcc/ada/exp_sel.adb @@ -23,12 +23,14 @@ -- -- ------------------------------------------------------------------------------ -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index 2a247ec3c23..8ebc571b26e 100644 --- a/gcc/ada/exp_smem.adb +++ b/gcc/ada/exp_smem.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Ch7; use Exp_Ch7; with Exp_Ch9; use Exp_Ch9; @@ -37,7 +39,9 @@ with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index 6d3f49b680d..aa5e6a01fb1 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Exp_Attr; with Exp_Ch4; with Exp_Ch5; use Exp_Ch5; @@ -40,7 +42,9 @@ with Sem_Ch8; use Sem_Ch8; with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index bf24d632623..4502d51c87a 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Util; use Exp_Util; with Namet; use Namet; @@ -33,7 +35,9 @@ with Nmake; use Nmake; with Rtsfind; use Rtsfind; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index 5f96d976ee0..10a68029f84 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Util; use Exp_Util; with Nlists; use Nlists; @@ -34,7 +36,8 @@ with Rident; use Rident; with Sem_Aux; use Sem_Aux; with Sem_Ch6; use Sem_Ch6; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; package body Exp_Tss is diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index dda8d868004..f19a591efca 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_Util; use Exp_Util; with Lib; use Lib; @@ -41,7 +43,9 @@ with Sem_Ch8; use Sem_Ch8; with Sem_Mech; use Sem_Mech; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index c461acd6813..8137afb3ca8 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -28,7 +28,9 @@ with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Aggr; use Exp_Aggr; @@ -57,6 +59,7 @@ with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -9183,7 +9186,7 @@ package body Exp_Util is -- True if object reference with volatile type - elsif Is_Volatile_Object (N) then + elsif Is_Volatile_Object_Ref (N) then return True; -- True if reference to volatile entity @@ -12203,15 +12206,28 @@ package body Exp_Util is if Nkind (Context) in N_Subprogram_Call and then No (Type_Map.Get (Entity (Name (Context)))) then - New_Ref := - Convert_To (Type_Of_Formal (Context, Old_Ref), New_Ref); - - -- Do not process the generated type conversion because - -- both the parent type and the derived type are in the - -- Type_Map table. This will clobber the type conversion - -- by resetting its subtype mark. - - Result := Skip; + declare + -- We need to use the Original_Node of the callee, in + -- case it was already modified. Note that we are using + -- Traverse_Proc to walk the tree, and it is defined to + -- walk subtrees in an arbitrary order. + + Callee : constant Entity_Id := + Entity (Original_Node (Name (Context))); + begin + if No (Type_Map.Get (Callee)) then + New_Ref := + Convert_To + (Type_Of_Formal (Context, Old_Ref), New_Ref); + + -- Do not process the generated type conversion + -- because both the parent type and the derived type + -- are in the Type_Map table. This will clobber the + -- type conversion by resetting its subtype mark. + + Result := Skip; + end if; + end; end if; -- Otherwise there is nothing to replace diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 7f1a93222d5..e114e07bb7d 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -28,7 +28,8 @@ with Exp_Tss; use Exp_Tss; with Namet; use Namet; with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Types; use Types; with Uintp; use Uintp; diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index 65ae74186bd..5ae85ea420a 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -47,7 +47,8 @@ with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Ch8; use Sem_Ch8; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Table; package body Expander is diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index e19745eff4a..9c4a5723f52 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -69,14 +69,14 @@ extern Boolean Debug_Flag_NN; /* einfo: */ -#define Set_Alignment einfo__set_alignment -#define Set_Component_Bit_Offset einfo__set_component_bit_offset -#define Set_Component_Size einfo__set_component_size -#define Set_Esize einfo__set_esize -#define Set_Mechanism einfo__set_mechanism -#define Set_Normalized_First_Bit einfo__set_normalized_first_bit -#define Set_Normalized_Position einfo__set_normalized_position -#define Set_RM_Size einfo__set_rm_size +#define Set_Alignment einfo__entities__set_alignment +#define Set_Component_Bit_Offset einfo__entities__set_component_bit_offset +#define Set_Component_Size einfo__entities__set_component_size +#define Set_Esize einfo__entities__set_esize +#define Set_Mechanism einfo__entities__set_mechanism +#define Set_Normalized_First_Bit einfo__entities__set_normalized_first_bit +#define Set_Normalized_Position einfo__entities__set_normalized_position +#define Set_RM_Size einfo__entities__set_rm_size extern void Set_Alignment (Entity_Id, Uint); extern void Set_Component_Bit_Offset (Entity_Id, Uint); @@ -87,11 +87,11 @@ extern void Set_Normalized_First_Bit (Entity_Id, Uint); extern void Set_Normalized_Position (Entity_Id, Uint); extern void Set_RM_Size (Entity_Id, Uint); -#define Is_Entity_Name einfo__is_entity_name +#define Is_Entity_Name einfo__utils__is_entity_name extern Boolean Is_Entity_Name (Node_Id); -#define Get_Attribute_Definition_Clause einfo__get_attribute_definition_clause +#define Get_Attribute_Definition_Clause einfo__utils__get_attribute_definition_clause extern Node_Id Get_Attribute_Definition_Clause (Entity_Id, unsigned char); @@ -301,9 +301,9 @@ extern Boolean Requires_Transient_Scope (Entity_Id); /* sinfo: */ -#define End_Location sinfo__end_location -#define Set_Has_No_Elaboration_Code sinfo__set_has_no_elaboration_code -#define Set_Present_Expr sinfo__set_present_expr +#define End_Location sinfo__utils__end_location +#define Set_Has_No_Elaboration_Code sinfo__nodes__set_has_no_elaboration_code +#define Set_Present_Expr sinfo__nodes__set_present_expr extern Source_Ptr End_Location (Node_Id); extern void Set_Has_No_Elaboration_Code (Node_Id, Boolean); @@ -343,6 +343,384 @@ extern Boolean Stack_Check_Probes_On_Target; extern Boolean Warn_On_Questionable_Layout; +// The following corresponds to Ada code in Einfo.Utils. + +typedef Boolean B; +typedef Component_Alignment_Kind C; +typedef Entity_Id E; +typedef Mechanism_Type M; +typedef Node_Id N; +typedef Uint U; +typedef Ureal R; +typedef Elist_Id L; +typedef List_Id S; + +#define Is_Access_Object_Type einfo__utils__is_access_object_type +B Is_Access_Object_Type (E Id); + +#define Is_Named_Access_Type einfo__utils__is_named_access_type +B Is_Named_Access_Type (E Id); + +#define Address_Clause einfo__utils__address_clause +N Address_Clause (E Id); + +#define Aft_Value einfo__utils__aft_value +U Aft_Value (E Id); + +#define Alignment_Clause einfo__utils__alignment_clause +N Alignment_Clause (E Id); + +#define Base_Type einfo__utils__base_type +E Base_Type (E Id); + +#define Declaration_Node einfo__utils__declaration_node +N Declaration_Node (E Id); + +#define Designated_Type einfo__utils__designated_type +E Designated_Type (E Id); + +#define First_Component einfo__utils__first_component +E First_Component (E Id); + +#define First_Component_Or_Discriminant einfo__utils__first_component_or_discriminant +E First_Component_Or_Discriminant (E Id); + +#define First_Formal einfo__utils__first_formal +E First_Formal (E Id); + +#define First_Formal_With_Extras einfo__utils__first_formal_with_extras +E First_Formal_With_Extras (E Id); + +#define Has_Attach_Handler einfo__utils__has_attach_handler +B Has_Attach_Handler (E Id); + +#define Has_Entries einfo__utils__has_entries +B Has_Entries (E Id); + +#define Has_Foreign_Convention einfo__utils__has_foreign_convention +B Has_Foreign_Convention (E Id); + +#define Has_Interrupt_Handler einfo__utils__has_interrupt_handler +B Has_Interrupt_Handler (E Id); + +#define Has_Non_Limited_View einfo__utils__has_non_limited_view +B Has_Non_Limited_View (E Id); + +#define Has_Non_Null_Abstract_State einfo__utils__has_non_null_abstract_state +B Has_Non_Null_Abstract_State (E Id); + +#define Has_Non_Null_Visible_Refinement einfo__utils__has_non_null_visible_refinement +B Has_Non_Null_Visible_Refinement (E Id); + +#define Has_Null_Abstract_State einfo__utils__has_null_abstract_state +B Has_Null_Abstract_State (E Id); + +#define Has_Null_Visible_Refinement einfo__utils__has_null_visible_refinement +B Has_Null_Visible_Refinement (E Id); + +#define Implementation_Base_Type einfo__utils__implementation_base_type +E Implementation_Base_Type (E Id); + +#define Is_Base_Type einfo__utils__is_base_type +B Is_Base_Type (E Id); + +#define Is_Boolean_Type einfo__utils__is_boolean_type +B Is_Boolean_Type (E Id); + +#define Is_Constant_Object einfo__utils__is_constant_object +B Is_Constant_Object (E Id); + +#define Is_Controlled einfo__utils__is_controlled +B Is_Controlled (E Id); + +#define Is_Discriminal einfo__utils__is_discriminal +B Is_Discriminal (E Id); + +#define Is_Dynamic_Scope einfo__utils__is_dynamic_scope +B Is_Dynamic_Scope (E Id); + +#define Is_Elaboration_Target einfo__utils__is_elaboration_target +B Is_Elaboration_Target (E Id); + +#define Is_External_State einfo__utils__is_external_state +B Is_External_State (E Id); + +#define Is_Finalizer einfo__utils__is_finalizer +B Is_Finalizer (E Id); + +#define Is_Null_State einfo__utils__is_null_state +B Is_Null_State (E Id); + +#define Is_Package_Or_Generic_Package einfo__utils__is_package_or_generic_package +B Is_Package_Or_Generic_Package (E Id); + +#define Is_Packed_Array einfo__utils__is_packed_array +B Is_Packed_Array (E Id); + +#define Is_Prival einfo__utils__is_prival +B Is_Prival (E Id); + +#define Is_Protected_Component einfo__utils__is_protected_component +B Is_Protected_Component (E Id); + +#define Is_Protected_Interface einfo__utils__is_protected_interface +B Is_Protected_Interface (E Id); + +#define Is_Protected_Record_Type einfo__utils__is_protected_record_type +B Is_Protected_Record_Type (E Id); + +#define Is_Relaxed_Initialization_State einfo__utils__is_relaxed_initialization_state +B Is_Relaxed_Initialization_State (E Id); + +#define Is_Standard_Character_Type einfo__utils__is_standard_character_type +B Is_Standard_Character_Type (E Id); + +#define Is_Standard_String_Type einfo__utils__is_standard_string_type +B Is_Standard_String_Type (E Id); + +#define Is_String_Type einfo__utils__is_string_type +B Is_String_Type (E Id); + +#define Is_Synchronized_Interface einfo__utils__is_synchronized_interface +B Is_Synchronized_Interface (E Id); + +#define Is_Synchronized_State einfo__utils__is_synchronized_state +B Is_Synchronized_State (E Id); + +#define Is_Task_Interface einfo__utils__is_task_interface +B Is_Task_Interface (E Id); + +#define Is_Task_Record_Type einfo__utils__is_task_record_type +B Is_Task_Record_Type (E Id); + +#define Is_Wrapper_Package einfo__utils__is_wrapper_package +B Is_Wrapper_Package (E Id); + +#define Last_Formal einfo__utils__last_formal +E Last_Formal (E Id); + +#define Machine_Emax_Value einfo__utils__machine_emax_value +U Machine_Emax_Value (E Id); + +#define Machine_Emin_Value einfo__utils__machine_emin_value +U Machine_Emin_Value (E Id); + +#define Machine_Mantissa_Value einfo__utils__machine_mantissa_value +U Machine_Mantissa_Value (E Id); + +#define Machine_Radix_Value einfo__utils__machine_radix_value +U Machine_Radix_Value (E Id); + +#define Model_Emin_Value einfo__utils__model_emin_value +U Model_Emin_Value (E Id); + +#define Model_Epsilon_Value einfo__utils__model_epsilon_value +R Model_Epsilon_Value (E Id); + +#define Model_Mantissa_Value einfo__utils__model_mantissa_value +U Model_Mantissa_Value (E Id); + +#define Model_Small_Value einfo__utils__model_small_value +R Model_Small_Value (E Id); + +#define Next_Component einfo__utils__next_component +E Next_Component (E Id); + +#define Next_Component_Or_Discriminant einfo__utils__next_component_or_discriminant +E Next_Component_Or_Discriminant (E Id); + +#define Next_Discriminant einfo__utils__next_discriminant +E Next_Discriminant (E Id); + +#define Next_Formal einfo__utils__next_formal +E Next_Formal (E Id); + +#define Next_Formal_With_Extras einfo__utils__next_formal_with_extras +E Next_Formal_With_Extras (E Id); + +#define Number_Dimensions einfo__utils__number_dimensions +Pos Number_Dimensions (E Id); + +#define Number_Entries einfo__utils__number_entries +Nat Number_Entries (E Id); + +#define Number_Formals einfo__utils__number_formals +Pos Number_Formals (E Id); + +#define Object_Size_Clause einfo__utils__object_size_clause +N Object_Size_Clause (E Id); + +#define Partial_Refinement_Constituents einfo__utils__partial_refinement_constituents +L Partial_Refinement_Constituents (E Id); + +#define Primitive_Operations einfo__utils__primitive_operations +L Primitive_Operations (E Id); + +#define Root_Type einfo__utils__root_type +E Root_Type (E Id); + +#define Safe_Emax_Value einfo__utils__safe_emax_value +U Safe_Emax_Value (E Id); + +#define Safe_First_Value einfo__utils__safe_first_value +R Safe_First_Value (E Id); + +#define Safe_Last_Value einfo__utils__safe_last_value +R Safe_Last_Value (E Id); + +#define Scope_Depth einfo__utils__scope_depth +U Scope_Depth (E Id); + +#define Scope_Depth_Set einfo__utils__scope_depth_set +B Scope_Depth_Set (E Id); + +#define Size_Clause einfo__utils__size_clause +N Size_Clause (E Id); + +#define Stream_Size_Clause einfo__utils__stream_size_clause +N Stream_Size_Clause (E Id); + +#define Type_High_Bound einfo__utils__type_high_bound +N Type_High_Bound (E Id); + +#define Type_Low_Bound einfo__utils__type_low_bound +N Type_Low_Bound (E Id); + +#define Underlying_Type einfo__utils__underlying_type +E Underlying_Type (E Id); + +#define Known_Alignment einfo__utils__known_alignment +B Known_Alignment (Entity_Id E); + +#define Known_Component_Bit_Offset einfo__utils__known_component_bit_offset +B Known_Component_Bit_Offset (Entity_Id E); + +#define Known_Component_Size einfo__utils__known_component_size +B Known_Component_Size (Entity_Id E); + +#define Known_Esize einfo__utils__known_esize +B Known_Esize (Entity_Id E); + +#define Known_Normalized_First_Bit einfo__utils__known_normalized_first_bit +B Known_Normalized_First_Bit (Entity_Id E); + +#define Known_Normalized_Position einfo__utils__known_normalized_position +B Known_Normalized_Position (Entity_Id E); + +#define Known_Normalized_Position_Max einfo__utils__known_normalized_position_max +B Known_Normalized_Position_Max (Entity_Id E); + +#define Known_RM_Size einfo__utils__known_rm_size +B Known_RM_Size (Entity_Id E); + +#define Known_Static_Component_Bit_Offset einfo__utils__known_static_component_bit_offset +B Known_Static_Component_Bit_Offset (Entity_Id E); + +#define Known_Static_Component_Size einfo__utils__known_static_component_size +B Known_Static_Component_Size (Entity_Id E); + +#define Known_Static_Esize einfo__utils__known_static_esize +B Known_Static_Esize (Entity_Id E); + +#define Known_Static_Normalized_First_Bit einfo__utils__known_static_normalized_first_bit +B Known_Static_Normalized_First_Bit (Entity_Id E); + +#define Known_Static_Normalized_Position einfo__utils__known_static_normalized_position +B Known_Static_Normalized_Position (Entity_Id E); + +#define Known_Static_Normalized_Position_Max einfo__utils__known_static_normalized_position_max +B Known_Static_Normalized_Position_Max (Entity_Id E); + +#define Known_Static_RM_Size einfo__utils__known_static_rm_size +B Known_Static_RM_Size (Entity_Id E); + +#define Unknown_Alignment einfo__utils__unknown_alignment +B Unknown_Alignment (Entity_Id E); + +#define Unknown_Component_Bit_Offset einfo__utils__unknown_component_bit_offset +B Unknown_Component_Bit_Offset (Entity_Id E); + +#define Unknown_Component_Size einfo__utils__unknown_component_size +B Unknown_Component_Size (Entity_Id E); + +#define Unknown_Esize einfo__utils__unknown_esize +B Unknown_Esize (Entity_Id E); + +#define Unknown_Normalized_First_Bit einfo__utils__unknown_normalized_first_bit +B Unknown_Normalized_First_Bit (Entity_Id E); + +#define Unknown_Normalized_Position einfo__utils__unknown_normalized_position +B Unknown_Normalized_Position (Entity_Id E); + +#define Unknown_Normalized_Position_Max einfo__utils__unknown_normalized_position_max +B Unknown_Normalized_Position_Max (Entity_Id E); + +#define Unknown_RM_Size einfo__utils__unknown_rm_size +B Unknown_RM_Size (Entity_Id E); + +// The following were automatically generated as INLINE functions in the old +// einfo.h by the spitbol program. +// Is it important that they be inlined???? + +#define Is_Discrete_Or_Fixed_Point_Type einfo__utils__is_discrete_or_fixed_point_type +B Is_Discrete_Or_Fixed_Point_Type (E Id); + +#define Is_Floating_Point_Type einfo__utils__is_floating_point_type +B Is_Floating_Point_Type (E Id); + +#define Is_Record_Type einfo__utils__is_record_type +B Is_Record_Type (E Id); + +#define Has_DIC einfo__utils__has_dic +B Has_DIC (E Id); + +#define Has_Invariants einfo__utils__has_invariants +B Has_Invariants (E Id); + +#define Is_Full_Access einfo__utils__is_full_access +B Is_Full_Access (E Id); + +#define Next_Index einfo__utils__next_index +Node_Id Next_Index (Node_Id Id); + +#define Next_Literal einfo__utils__next_literal +E Next_Literal (E Id); + +#define Next_Stored_Discriminant einfo__utils__next_stored_discriminant +E Next_Stored_Discriminant (E Id); + +#define Parameter_Mode einfo__utils__parameter_mode +// Parameter_Mode really returns Formal_Kind, but that is not visible, because +// fe.h is included before einfo.h. +Entity_Kind Parameter_Mode (E Id); + +#define Is_List_Member einfo__utils__is_list_member +B Is_List_Member (N Node); + +#define List_Containing einfo__utils__list_containing +S List_Containing (N Node); + +// The following is needed because Convention in Sem_Util is a renaming +// of Basic_Convention. + +#define Convention einfo__entities__basic_convention +Convention_Id Convention (N Node); + +// See comments regarding Entity_Or_Associated_Node in Sinfo.Utils. + +#define Entity sinfo__nodes__entity_or_associated_node +Entity_Id Entity (N Node); + +// See comments regarding Renamed_Or_Alias in Einfo.Utils + +#define Alias einfo__entities__renamed_or_alias + +#define Renamed_Entity einfo__entities__renamed_or_alias +Node_Id Renamed_Entity (N Node); + +#define Renamed_Object einfo__entities__renamed_or_alias +Node_Id Renamed_Object (N Node); + #ifdef __cplusplus } #endif diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 061e3836497..0b807758cc9 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -28,7 +28,9 @@ with Atree; use Atree; with Checks; use Checks; with Contracts; use Contracts; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Ch3; use Exp_Ch3; @@ -59,7 +61,9 @@ with Sem_Mech; use Sem_Mech; with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -7545,7 +7549,7 @@ package body Freeze is Typ := Empty; - if Nkind (N) in N_Has_Etype then + if Nkind (N) in N_Has_Etype and then Present (Etype (N)) then if not Is_Frozen (Etype (N)) then Typ := Etype (N); @@ -7566,6 +7570,7 @@ package body Freeze is -- an initialization procedure from freezing the variable. if Is_Entity_Name (N) + and then Present (Entity (N)) and then not Is_Frozen (Entity (N)) and then (Nkind (N) /= N_Identifier or else Comes_From_Source (N) diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 7072d674e70..8d4636d3086 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -60,7 +60,9 @@ with Sem_SCIL; with Sem_Elab; use Sem_Elab; with Sem_Prag; use Sem_Prag; with Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Sinput.L; use Sinput.L; with SCIL_LL; diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 6e873e25f0d..969022e21a7 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -272,6 +272,8 @@ GNAT_ADA_OBJS = \ ada/cstand.o \ ada/debug.o \ ada/debug_a.o \ + ada/einfo-entities.o \ + ada/einfo-utils.o \ ada/einfo.o \ ada/elists.o \ ada/err_vars.o \ @@ -424,6 +426,7 @@ GNAT_ADA_OBJS = \ ada/scng.o \ ada/scos.o \ ada/sdefault.o \ + ada/seinfo.o \ ada/sem.o \ ada/sem_aggr.o \ ada/sem_attr.o \ @@ -459,6 +462,8 @@ GNAT_ADA_OBJS = \ ada/sem_warn.o \ ada/set_targ.o \ ada/sinfo-cn.o \ + ada/sinfo-nodes.o \ + ada/sinfo-utils.o \ ada/sinfo.o \ ada/sinput-d.o \ ada/sinput-l.o \ @@ -478,7 +483,6 @@ GNAT_ADA_OBJS = \ ada/targparm.o \ ada/tbuild.o \ ada/treepr.o \ - ada/treeprs.o \ ada/ttypes.o \ ada/types.o \ ada/uintp.o \ @@ -526,6 +530,8 @@ GNATBIND_OBJS = \ ada/csets.o \ ada/cstreams.o \ ada/debug.o \ + ada/einfo-entities.o \ + ada/einfo-utils.o \ ada/einfo.o \ ada/elists.o \ ada/env.o \ @@ -618,7 +624,10 @@ GNATBIND_OBJS = \ ada/scng.o \ ada/sdefault.o \ ada/seh_init.o \ + ada/seinfo.o \ ada/sem_aux.o \ + ada/sinfo-nodes.o \ + ada/sinfo-utils.o \ ada/sinfo.o \ ada/sinput-c.o \ ada/sinput.o \ @@ -879,7 +888,7 @@ ada.mostlyclean: -$(RM) ada/*$(objext) ada/*.ali ada/b_gnat*.ads ada/b_gnat*.adb -$(RM) ada/*$(objext).gnatd.n -$(RM) ada/*$(coverageexts) - -$(RM) ada/sdefault.adb ada/stamp-sdefault ada/stamp-snames + -$(RM) ada/stamp-sdefault ada/stamp-snames ada/stamp-gen_il -$(RMDIR) ada/tools -$(RMDIR) ada/libgnat -$(RM) gnatbind$(exeext) gnat1$(exeext) @@ -907,7 +916,6 @@ ada.maintainer-clean: -$(RM) ada/einfo.h -$(RM) ada/nmake.adb -$(RM) ada/nmake.ads - -$(RM) ada/treeprs.ads -$(RM) ada/snames.ads ada/snames.adb ada/snames.h # Stage hooks: @@ -1033,11 +1041,6 @@ ada/b_gnatb.o : ada/b_gnatb.adb include $(srcdir)/ada/Make-generated.in -update-sources : ada/treeprs.ads ada/einfo.h ada/sinfo.h ada/nmake.adb \ - ada/nmake.ads - $(RM) $(addprefix $(srcdir)/ada/,$(notdir $^)) - $(CP) $^ $(srcdir)/ada - ada/sdefault.o : ada/libgnat/ada.ads ada/libgnat/a-except.ads ada/libgnat/a-unccon.ads \ ada/libgnat/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/hostparm.ads ada/namet.ads \ ada/opt.ads ada/osint.ads ada/output.ads ada/sdefault.ads ada/sdefault.adb \ @@ -1099,13 +1102,23 @@ ada/mdll-fil.o : ada/mdll-fil.adb ada/mdll.ads ada/mdll-fil.ads ada/mdll-utl.o : ada/mdll-utl.adb ada/mdll.ads ada/mdll-utl.ads ada/sdefault.ads ada/types.ads $(CC) -c $(ALL_ADAFLAGS) $(ADA_INCLUDES) $< $(ADA_OUTPUT_OPTION) -ada_generated_files = ada/sinfo.h ada/einfo.h ada/nmake.adb ada/nmake.ads \ - ada/treeprs.ads ada/snames.ads ada/snames.adb ada/snames.h \ - ada/generated/gnatvsn.ads +# All generated files. Perhaps we should build all of these in the same +# subdirectory, and get rid of ada/bldtools. +ADA_GENERATED_FILES = ada/sinfo.h ada/einfo.h ada/nmake.adb ada/nmake.ads \ + ada/snames.ads ada/snames.adb ada/snames.h \ + ada/generated/gnatvsn.ads \ + ada/seinfo.ads \ + ada/seinfo_tables.ads ada/seinfo_tables.adb \ + ada/sinfo-nodes.ads ada/sinfo-nodes.adb \ + ada/einfo-entities.ads ada/einfo-entities.adb + +# Only used to manually trigger the creation of the generated files. +.PHONY: +ada_generated_files: $(ADA_GENERATED_FILES) # When building from scratch we don't have dependency files, the only thing # we need to ensure is that the generated files are created first. -$(GNAT1_OBJS) $(GNATBIND_OBJS): | $(ada_generated_files) +$(GNAT1_OBJS) $(GNATBIND_OBJS): | $(ADA_GENERATED_FILES) # Manually include the auto-generated dependencies for the Ada host objects. ADA_DEPFILES = $(foreach obj,$(GNAT1_ADA_OBJS) $(GNATBIND_OBJS),\ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 836fcbef400..333e2035455 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -104,7 +104,7 @@ TEXI2DVI = texi2dvi TEXI2PDF = texi2pdf GNATBIND_FLAGS = -static -x ADA_CFLAGS = -ADAFLAGS = -W -Wall -gnatpg -gnata +ADAFLAGS = -W -Wall -gnatpg -gnata -gnatU FORCE_DEBUG_ADAFLAGS = -g NO_INLINE_ADAFLAGS = -fno-inline NO_OMIT_ADAFLAGS = -fno-omit-frame-pointer @@ -332,6 +332,7 @@ GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \ snames.o stand.o stringt.o styleg.o stylesw.o system.o validsw.o \ switch.o switch-m.o table.o targparm.o tempdir.o types.o uintp.o \ uname.o urealp.o usage.o widechar.o \ + seinfo.o einfo-entities.o einfo-utils.o sinfo-nodes.o sinfo-utils.o \ $(EXTRA_GNATMAKE_OBJS) # Make arch match the current multilib so that the RTS selection code @@ -383,15 +384,20 @@ TOOLS_FLAGS_TO_PASS= \ GCC_LINK=$(CXX) $(GCC_LINK_FLAGS) $(LDFLAGS) -# Build directory for the tools. Let's copy the target-dependent -# sources using the same mechanism as for gnatlib. The other sources are -# accessed using the vpath directive below +# Build directory for the tools. We first need to copy the generated files, +# then the target-dependent sources using the same mechanism as for gnatlib. +# The other sources are accessed using the vpath directive below + +GENERATED_FILES_FOR_TOOLS = \ + einfo-entities.ads einfo-entities.adb sdefault.adb seinfo.ads \ + sinfo-nodes.ads sinfo-nodes.adb snames.ads snames.adb ../stamp-tools: -$(RM) tools/* -$(RMDIR) tools -$(MKDIR) tools - -(cd tools; $(LN_S) ../sdefault.adb ../snames.ads ../snames.adb .) + -(cd tools; $(foreach FILE,$(GENERATED_FILES_FOR_TOOLS), \ + $(LN_S) ../$(FILE) $(FILE);)) -$(foreach PAIR,$(TOOLS_TARGET_PAIRS), \ $(RM) tools/$(word 1,$(subst <, ,$(PAIR)));\ $(LN_S) $(fsrcpfx)ada/$(word 2,$(subst <, ,$(PAIR))) \ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 6e7abfcec70..b4c4653052c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -434,7 +434,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) gcc_assert (!is_type || Known_Esize (gnat_entity) || Has_Size_Clause (gnat_entity) - || (!IN (kind, Numeric_Kind) + || (!Is_In_Numeric_Kind (kind) && !IN (kind, Enumeration_Kind) && (!IN (kind, Access_Kind) || kind == E_Access_Protected_Subprogram_Type @@ -443,7 +443,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) || type_annotate_only))); /* The RM size must be specified for all discrete and fixed-point types. */ - gcc_assert (!(IN (kind, Discrete_Or_Fixed_Point_Kind) + gcc_assert (!(Is_In_Discrete_Or_Fixed_Point_Kind (kind) && Unknown_RM_Size (gnat_entity))); /* If we get here, it means we have not yet done anything with this entity. @@ -4568,7 +4568,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* Similarly, if this is a record type or subtype at global level, call elaborate_expression_2 on any field position. Skip any fields that we haven't made trees for to avoid problems with class-wide types. */ - if (IN (kind, Record_Kind) && global_bindings_p ()) + if (Is_In_Record_Kind (kind) && global_bindings_p ()) for (gnat_temp = First_Entity (gnat_entity); Present (gnat_temp); gnat_temp = Next_Entity (gnat_temp)) if (Ekind (gnat_temp) == E_Component && present_gnu_tree (gnat_temp)) @@ -7675,7 +7675,7 @@ typedef struct vinfo will be the single field of GNU_RECORD_TYPE and the GCC nodes for the discriminants will be on GNU_FIELD_LIST. The other call to this function is a recursive call for the component list of a variant and, in this case, - GNU_FIELD_LIST is empty. + GNU_FIELD_LIST is empty. Note that GNAT_COMPONENT_LIST may be Empty. PACKED is 1 if this is for a packed record or -1 if this is for a record with Component_Alignment of Storage_Unit. @@ -7731,7 +7731,8 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, /* For each component referenced in a component declaration create a GCC field and add it to the list, skipping pragmas in the GNAT list. */ gnu_last = tree_last (gnu_field_list); - if (Present (Component_Items (gnat_component_list))) + if (Present (gnat_component_list) + && (Present (Component_Items (gnat_component_list)))) for (gnat_component_decl = First_Non_Pragma (Component_Items (gnat_component_list)); Present (gnat_component_decl); @@ -7788,7 +7789,10 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, } /* At the end of the component list there may be a variant part. */ - gnat_variant_part = Variant_Part (gnat_component_list); + if (Present (gnat_component_list)) + gnat_variant_part = Variant_Part (gnat_component_list); + else + gnat_variant_part = Empty; /* We create a QUAL_UNION_TYPE for the variant part since the variants are mutually exclusive and should go in the same memory. To do this we need diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 2066f289474..7b754dad174 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -233,24 +233,24 @@ extern "C" { structures and then generates code. */ extern void gigi (Node_Id gnat_root, int max_gnat_node, - int number_name, - struct Node *nodes_ptr, - struct Flags *Flags_Ptr, + int number_name, + Field_Offset *node_offsets_ptr, + slot *Slots, Node_Id *next_node_ptr, Node_Id *prev_node_ptr, struct Elist_Header *elists_ptr, - struct Elmt_Item *elmts_ptr, - struct String_Entry *strings_ptr, - Char_Code *strings_chars_ptr, - struct List_Header *list_headers_ptr, - Nat number_file, - struct File_Info_Type *file_info_ptr, - Entity_Id standard_boolean, - Entity_Id standard_integer, - Entity_Id standard_character, - Entity_Id standard_long_long_float, - Entity_Id standard_exception_type, - Int gigi_operating_mode); + struct Elmt_Item *elmts_ptr, + struct String_Entry *strings_ptr, + Char_Code *strings_chars_ptr, + struct List_Header *list_headers_ptr, + Nat number_file, + struct File_Info_Type *file_info_ptr, + Entity_Id standard_boolean, + Entity_Id standard_integer, + Entity_Id standard_character, + Entity_Id standard_long_long_float, + Entity_Id standard_exception_type, + Int gigi_operating_mode); #ifdef __cplusplus } diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index f0fead7c06c..61a9d6185a6 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -75,8 +75,8 @@ #define ALLOCA_THRESHOLD 1000 /* Pointers to front-end tables accessed through macros. */ -struct Node *Nodes_Ptr; -struct Flags *Flags_Ptr; +Field_Offset *Node_Offsets_Ptr; +slot *Slots_Ptr; Node_Id *Next_Node_Ptr; Node_Id *Prev_Node_Ptr; struct Elist_Header *Elists_Ptr; @@ -279,8 +279,8 @@ void gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, - struct Node *nodes_ptr, - struct Flags *flags_ptr, + Field_Offset *node_offsets_ptr, + slot *slots_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr, struct Elist_Header *elists_ptr, @@ -305,8 +305,8 @@ gigi (Node_Id gnat_root, max_gnat_nodes = max_gnat_node; - Nodes_Ptr = nodes_ptr; - Flags_Ptr = flags_ptr; + Node_Offsets_Ptr = node_offsets_ptr; + Slots_Ptr = slots_ptr; Next_Node_Ptr = next_node_ptr; Prev_Node_Ptr = prev_node_ptr; Elists_Ptr = elists_ptr; diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads new file mode 100644 index 00000000000..7948d2688a2 --- /dev/null +++ b/gcc/ada/gen_il-fields.ads @@ -0,0 +1,923 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . F I E L D S -- +-- -- +-- 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. 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. -- +-- -- +------------------------------------------------------------------------------ + +package Gen_IL.Fields is + + -- The following is "optional field enumeration" -- i.e. it is Field_Enum + -- (declared in Gen_IL.Utils) plus the special null value No_Field. + -- See the spec of Gen_IL.Gen for how to modify this. + + type Opt_Field_Enum is + (No_Field, + + -- Start of node fields: + + Nkind, + Sloc, + In_List, + Rewrite_Ins, + Comes_From_Source, + Analyzed, + Error_Posted, + Small_Paren_Count, + Check_Actuals, + Has_Aspects, + Is_Ignored_Ghost_Node, + Link, + + Abort_Present, + Abortable_Part, + Abstract_Present, + Accept_Handler_Records, + Accept_Statement, + Access_Definition, + Access_To_Subprogram_Definition, + Access_Types_To_Process, + Actions, + Activation_Chain_Entity, + Acts_As_Spec, + Actual_Designated_Subtype, + Address_Warning_Posted, + Aggregate_Bounds, + Aliased_Present, + Alloc_For_BIP_Return, + All_Others, + All_Present, + Alternatives, + Ancestor_Part, + Atomic_Sync_Required, + Array_Aggregate, + Aspect_On_Partial_View, + Aspect_Rep_Item, + Assignment_OK, + Attribute_Name, + At_End_Proc, + Aux_Decls_Node, + Backwards_OK, + Bad_Is_Detected, + Body_Required, + Body_To_Inline, + Box_Present, + By_Ref, + Char_Literal_Value, + Chars, + Check_Address_Alignment, + Choice_Parameter, + Choices, + Class_Present, + Classifications, + Cleanup_Actions, + Comes_From_Extended_Return_Statement, + Compile_Time_Known_Aggregate, + Component_Associations, + Component_Clauses, + Component_Definition, + Component_Items, + Component_List, + Component_Name, + Componentwise_Assignment, + Condition, + Condition_Actions, + Config_Pragmas, + Constant_Present, + Constraint, + Constraints, + Context_Installed, + Context_Items, + Context_Pending, + Contract_Test_Cases, + Controlling_Argument, + Conversion_OK, + Convert_To_Return_False, + Corresponding_Aspect, + Corresponding_Body, + Corresponding_Formal_Spec, + Corresponding_Generic_Association, + Corresponding_Integer_Value, + Corresponding_Spec, + Corresponding_Spec_Of_Stub, + Corresponding_Stub, + Dcheck_Function, + Declarations, + Default_Expression, + Default_Storage_Pool, + Default_Name, + Defining_Identifier, + Defining_Unit_Name, + Delay_Alternative, + Delay_Statement, + Delta_Expression, + Digits_Expression, + Discr_Check_Funcs_Built, + Discrete_Choices, + Discrete_Range, + Discrete_Subtype_Definition, + Discrete_Subtype_Definitions, + Discriminant_Specifications, + Discriminant_Type, + Do_Accessibility_Check, + Do_Discriminant_Check, + Do_Division_Check, + Do_Length_Check, + Do_Overflow_Check, + Do_Range_Check, + Do_Storage_Check, + Do_Tag_Check, + Elaborate_All_Desirable, + Elaborate_All_Present, + Elaborate_Desirable, + Elaborate_Present, + Else_Actions, + Else_Statements, + Elsif_Parts, + Enclosing_Variant, + End_Label, + End_Span, + Entity_Or_Associated_Node, + Entry_Body_Formal_Part, + Entry_Call_Alternative, + Entry_Call_Statement, + Entry_Direct_Name, + Entry_Index, + Entry_Index_Specification, + Etype, + Exception_Choices, + Exception_Handlers, + Exception_Junk, + Exception_Label, + Expansion_Delayed, + Explicit_Actual_Parameter, + Explicit_Generic_Actual_Parameter, + Expression, + Expression_Copy, + Expressions, + First_Bit, + First_Inlined_Subprogram, + First_Name, + First_Named_Actual, + First_Real_Statement, + First_Subtype_Link, + Float_Truncate, + Formal_Type_Definition, + Forwards_OK, + From_Aspect_Specification, + From_At_End, + From_At_Mod, + From_Conditional_Expression, + From_Default, + Generalized_Indexing, + Generic_Associations, + Generic_Formal_Declarations, + Generic_Parent, + Generic_Parent_Type, + Handled_Statement_Sequence, + Handler_List_Entry, + Has_Created_Identifier, + Has_Dereference_Action, + Has_Dynamic_Length_Check, + Has_Init_Expression, + Has_Local_Raise, + Has_No_Elaboration_Code, + Has_Pragma_Suppress_All, + Has_Private_View, + Has_Relative_Deadline_Pragma, + Has_Self_Reference, + Has_SP_Choice, + Has_Storage_Size_Pragma, + Has_Target_Names, + Has_Wide_Character, + Has_Wide_Wide_Character, + Header_Size_Added, + Hidden_By_Use_Clause, + High_Bound, + Identifier, + Interface_List, + Interface_Present, + Implicit_With, + Import_Interface_Present, + In_Present, + Includes_Infinities, + Incomplete_View, + Inherited_Discriminant, + Instance_Spec, + Intval, + Is_Abort_Block, + Is_Accessibility_Actual, + Is_Analyzed_Pragma, + Is_Asynchronous_Call_Block, + Is_Boolean_Aspect, + Is_Checked, + Is_Checked_Ghost_Pragma, + Is_Component_Left_Opnd, + Is_Component_Right_Opnd, + Is_Controlling_Actual, + Is_Declaration_Level_Node, + Is_Delayed_Aspect, + Is_Disabled, + Is_Dispatching_Call, + Is_Dynamic_Coextension, + Is_Effective_Use_Clause, + Is_Elaboration_Checks_OK_Node, + Is_Elaboration_Code, + Is_Elaboration_Warnings_OK_Node, + Is_Elsif, + Is_Entry_Barrier_Function, + Is_Expanded_Build_In_Place_Call, + Is_Expanded_Contract, + Is_Finalization_Wrapper, + Is_Folded_In_Parser, + Is_Generic_Contract_Pragma, + Is_Homogeneous_Aggregate, + Is_Ignored, + Is_Ignored_Ghost_Pragma, + Is_In_Discriminant_Check, + Is_Inherited_Pragma, + Is_Initialization_Block, + Is_Known_Guaranteed_ABE, + Is_Machine_Number, + Is_Null_Loop, + Is_Overloaded, + Is_Power_Of_2_For_Shift, + Is_Preelaborable_Call, + Is_Prefixed_Call, + Is_Protected_Subprogram_Body, + Is_Qualified_Universal_Literal, + Is_Read, + Is_Source_Call, + Is_SPARK_Mode_On_Node, + Is_Static_Coextension, + Is_Static_Expression, + Is_Subprogram_Descriptor, + Is_Task_Allocation_Block, + Is_Task_Body_Procedure, + Is_Task_Master, + Is_Write, + Iterator_Filter, + Iteration_Scheme, + Iterator_Specification, + Itype, + Key_Expression, + Kill_Range_Check, + Last_Bit, + Last_Name, + Library_Unit, + Label_Construct, + Left_Opnd, + Limited_View_Installed, + Limited_Present, + Literals, + Local_Raise_Not_OK, + Local_Raise_Statements, + Loop_Actions, + Loop_Parameter_Specification, + Low_Bound, + Mod_Clause, + More_Ids, + Must_Be_Byte_Aligned, + Must_Not_Freeze, + Must_Not_Override, + Must_Override, + Name, + Names, + Next_Entity, + Next_Exit_Statement, + Next_Implicit_With, + Next_Named_Actual, + Next_Pragma, + Next_Rep_Item, + Next_Use_Clause, + No_Ctrl_Actions, + No_Elaboration_Check, + No_Entities_Ref_In_Spec, + No_Initialization, + No_Minimize_Eliminate, + No_Side_Effect_Removal, + No_Truncation, + Null_Excluding_Subtype, + Null_Exclusion_Present, + Null_Exclusion_In_Return_Present, + Null_Present, + Null_Record_Present, + Null_Statement, + Object_Definition, + Of_Present, + Original_Discriminant, + Original_Entity, + Others_Discrete_Choices, + Out_Present, + Parameter_Associations, + Parameter_Specifications, + Parameter_Type, + Parent_Spec, + Parent_With, + Position, + Pragma_Argument_Associations, + Pragma_Identifier, + Pragmas_After, + Pragmas_Before, + Pre_Post_Conditions, + Prefix, + Premature_Use, + Present_Expr, + Prev_Ids, + Prev_Use_Clause, + Print_In_Hex, + Private_Declarations, + Private_Present, + Procedure_To_Call, + Proper_Body, + Protected_Definition, + Protected_Present, + Raises_Constraint_Error, + Range_Constraint, + Range_Expression, + Real_Range_Specification, + Realval, + Reason, + Record_Extension_Part, + Redundant_Use, + Renaming_Exception, + Result_Definition, + Return_Object_Declarations, + Return_Statement_Entity, + Reverse_Present, + Right_Opnd, + Rounded_Result, + Save_Invocation_Graph_Of_Body, + SCIL_Controlling_Tag, + SCIL_Entity, + SCIL_Tag_Value, + SCIL_Target_Prim, + Scope, + Select_Alternatives, + Selector_Name, + Selector_Names, + Shift_Count_OK, + Source_Type, + Specification, + Split_PPC, + Statements, + Storage_Pool, + Subpool_Handle_Name, + Strval, + Subtype_Indication, + Subtype_Mark, + Subtype_Marks, + Suppress_Assignment_Checks, + Suppress_Loop_Warnings, + Synchronized_Present, + Tagged_Present, + Target, + Target_Type, + Task_Definition, + Task_Present, + Then_Actions, + Then_Statements, + Triggering_Alternative, + Triggering_Statement, + TSS_Elist, + Type_Definition, + Uneval_Old_Accept, + Uneval_Old_Warn, + Unit, + Unknown_Discriminants_Present, + Unreferenced_In_Spec, + Variant_Part, + Variants, + Visible_Declarations, + Uninitialized_Variable, + Used_Operations, + Was_Attribute_Reference, + Was_Expression_Function, + Was_Originally_Stub, + + -- End of node fields. + + Between_Node_And_Entity_Fields, + + -- Start of entity fields: + + Ekind, + Basic_Convention, + Abstract_States, + Accept_Address, + Access_Disp_Table, + Access_Disp_Table_Elab_Flag, + Access_Subprogram_Wrapper, + Activation_Record_Component, + Actual_Subtype, + Address_Taken, +-- ?? Alias, + Alignment, + Anonymous_Designated_Type, + Anonymous_Masters, + Anonymous_Object, + Associated_Entity, + Associated_Formal_Package, + Associated_Node_For_Itype, + Associated_Storage_Pool, + Barrier_Function, + BIP_Initialization_Call, + Block_Node, + Body_Entity, + Body_Needed_For_Inlining, + Body_Needed_For_SAL, + Body_References, + C_Pass_By_Copy, + Can_Never_Be_Null, + Can_Use_Internal_Rep, + Checks_May_Be_Suppressed, + Class_Wide_Clone, + Class_Wide_Type, + Cloned_Subtype, + Component_Alignment, + Component_Bit_Offset, + Component_Clause, + Component_Size, + Component_Type, + Contract, + Contract_Wrapper, + Corresponding_Concurrent_Type, + Corresponding_Discriminant, + Corresponding_Equality, + Corresponding_Function, + Corresponding_Procedure, + Corresponding_Protected_Entry, + Corresponding_Record_Component, + Corresponding_Record_Type, + Corresponding_Remote_Type, + CR_Discriminant, + Current_Use_Clause, + Current_Value, + Debug_Info_Off, + Debug_Renaming_Link, + Default_Aspect_Component_Value, + Default_Aspect_Value, + Default_Expr_Function, + Default_Expressions_Processed, + Default_Value, + Delay_Cleanups, + Delay_Subprogram_Descriptors, + Delta_Value, + Dependent_Instances, + Depends_On_Private, + Derived_Type_Link, + Digits_Value, + Predicated_Parent, + Predicates_Ignored, + Direct_Primitive_Operations, + Directly_Designated_Type, + Disable_Controlled, + Discard_Names, + Discriminal, + Discriminal_Link, + Discriminant_Checking_Func, + Discriminant_Constraint, + Discriminant_Default_Value, + Discriminant_Number, + Dispatch_Table_Wrappers, + DT_Entry_Count, + DT_Offset_To_Top_Func, + DT_Position, + DTC_Entity, + Elaborate_Body_Desirable, + Elaboration_Entity, + Elaboration_Entity_Required, + Encapsulating_State, + Enclosing_Scope, + Entry_Accepted, + Entry_Bodies_Array, + Entry_Cancel_Parameter, + Entry_Component, + Entry_Formal, + Entry_Index_Constant, + Entry_Max_Queue_Lengths_Array, + Entry_Parameters_Type, + Enum_Pos_To_Rep, + Enumeration_Pos, + Enumeration_Rep, + Enumeration_Rep_Expr, + Equivalent_Type, + Esize, + Extra_Accessibility, + Extra_Accessibility_Of_Result, + Extra_Constrained, + Extra_Formal, + Extra_Formals, + Finalization_Master, + Finalize_Storage_Only, + Finalizer, + First_Entity, + First_Exit_Statement, + First_Index, + First_Literal, + First_Private_Entity, + First_Rep_Item, + Float_Rep, + Freeze_Node, + From_Limited_With, + Full_View, + Generic_Homonym, + Generic_Renamings, + Handler_Records, + Has_Aliased_Components, + Has_Alignment_Clause, + Has_All_Calls_Remote, + Has_Atomic_Components, + Has_Biased_Representation, + Has_Completion, + Has_Completion_In_Body, + Has_Complex_Representation, + Has_Component_Size_Clause, + Has_Constrained_Partial_View, + Has_Contiguous_Rep, + Has_Controlled_Component, + Has_Controlling_Result, + Has_Convention_Pragma, + Has_Default_Aspect, + Has_Delayed_Aspects, + Has_Delayed_Freeze, + Has_Delayed_Rep_Aspects, + Has_Discriminants, + Has_Dispatch_Table, + Has_Dynamic_Predicate_Aspect, + Has_Enumeration_Rep_Clause, + Has_Exit, + Has_Expanded_Contract, + Has_Forward_Instantiation, + Has_Fully_Qualified_Name, + Has_Gigi_Rep_Item, + Has_Homonym, + Has_Implicit_Dereference, + Has_Independent_Components, + Has_Inheritable_Invariants, + Has_Inherited_DIC, + Has_Inherited_Invariants, + Has_Initial_Value, + Has_Loop_Entry_Attributes, + Has_Machine_Radix_Clause, + Has_Master_Entity, + Has_Missing_Return, + Has_Nested_Block_With_Handler, + Has_Nested_Subprogram, + Has_Non_Standard_Rep, + Has_Object_Size_Clause, + Has_Out_Or_In_Out_Parameter, + Has_Own_DIC, + Has_Own_Invariants, + Has_Partial_Visible_Refinement, + Has_Per_Object_Constraint, + Has_Pragma_Controlled, + Has_Pragma_Elaborate_Body, + Has_Pragma_Inline, + Has_Pragma_Inline_Always, + Has_Pragma_No_Inline, + Has_Pragma_Ordered, + Has_Pragma_Pack, + Has_Pragma_Preelab_Init, + Has_Pragma_Pure, + Has_Pragma_Pure_Function, + Has_Pragma_Thread_Local_Storage, + Has_Pragma_Unmodified, + Has_Pragma_Unreferenced, + Has_Pragma_Unreferenced_Objects, + Has_Pragma_Unused, + Has_Predicates, + Has_Primitive_Operations, + Has_Private_Ancestor, + Has_Private_Declaration, + Has_Private_Extension, + Has_Protected, + Has_Qualified_Name, + Has_RACW, + Has_Record_Rep_Clause, + Has_Recursive_Call, + Has_Shift_Operator, + Has_Size_Clause, + Has_Small_Clause, + Has_Specified_Layout, + Has_Specified_Stream_Input, + Has_Specified_Stream_Output, + Has_Specified_Stream_Read, + Has_Specified_Stream_Write, + Has_Static_Discriminants, + Has_Static_Predicate, + Has_Static_Predicate_Aspect, + Has_Storage_Size_Clause, + Has_Stream_Size_Clause, + Has_Task, + Has_Timing_Event, + Has_Thunks, + Has_Unchecked_Union, + Has_Unknown_Discriminants, + Has_Visible_Refinement, + Has_Volatile_Components, + Has_Xref_Entry, + Has_Yield_Aspect, + Hiding_Loop_Variable, + Hidden_In_Formal_Instance, + Homonym, + Ignore_SPARK_Mode_Pragmas, + Import_Pragma, + Incomplete_Actuals, + In_Package_Body, + In_Private_Part, + In_Use, + Initialization_Statements, + Inner_Instances, + Interface_Alias, + Interface_Name, + Interfaces, + Is_Abstract_Subprogram, + Is_Abstract_Type, + Is_Access_Constant, + Is_Activation_Record, + Is_Actual_Subtype, + Is_Ada_2005_Only, + Is_Ada_2012_Only, + Is_Aliased, + Is_Asynchronous, + Is_Atomic, + Is_Bit_Packed_Array, + Is_Called, + Is_Character_Type, + Is_Checked_Ghost_Entity, + Is_Child_Unit, + Is_Class_Wide_Clone, + Is_Class_Wide_Equivalent_Type, + Is_Compilation_Unit, + Is_Completely_Hidden, + Is_Concurrent_Record_Type, + Is_Constr_Subt_For_U_Nominal, + Is_Constr_Subt_For_UN_Aliased, + Is_Constrained, + Is_Constructor, + Is_Controlled_Active, + Is_Controlling_Formal, + Is_CPP_Class, + Is_CUDA_Kernel, + Is_Descendant_Of_Address, + Is_DIC_Procedure, + Is_Discrim_SO_Function, + Is_Discriminant_Check_Function, + Is_Dispatch_Table_Entity, + Is_Dispatching_Operation, + Is_Elaboration_Checks_OK_Id, + Is_Elaboration_Warnings_OK_Id, + Is_Eliminated, + Is_Entry_Formal, + Is_Entry_Wrapper, + Is_Exception_Handler, + Is_Exported, + Is_Finalized_Transient, + Is_First_Subtype, + Is_Formal_Subprogram, + Is_Frozen, + Is_Generic_Actual_Subprogram, + Is_Generic_Actual_Type, + Is_Generic_Instance, + Is_Generic_Type, + Is_Hidden, + Is_Hidden_Non_Overridden_Subpgm, + Is_Hidden_Open_Scope, + Is_Ignored_Ghost_Entity, + Is_Ignored_Transient, + Is_Immediately_Visible, + Is_Implementation_Defined, + Is_Imported, + Is_Independent, + Is_Initial_Condition_Procedure, + Is_Inlined, + Is_Inlined_Always, + Is_Instantiated, + Is_Interface, + Is_Internal, + Is_Interrupt_Handler, + Is_Intrinsic_Subprogram, + Is_Invariant_Procedure, + Is_Itype, + Is_Known_Non_Null, + Is_Known_Null, + Is_Known_Valid, + Is_Limited_Composite, + Is_Limited_Interface, + Is_Limited_Record, + Is_Local_Anonymous_Access, + Is_Loop_Parameter, + Is_Machine_Code_Subprogram, + Is_Non_Static_Subtype, + Is_Null_Init_Proc, + Is_Obsolescent, + Is_Only_Out_Parameter, + Is_Package_Body_Entity, + Is_Packed, + Is_Packed_Array_Impl_Type, + Is_Param_Block_Component_Type, + Is_Partial_Invariant_Procedure, + Is_Potentially_Use_Visible, + Is_Predicate_Function, + Is_Predicate_Function_M, + Is_Preelaborated, + Is_Primitive, + Is_Primitive_Wrapper, + Is_Private_Composite, + Is_Private_Descendant, + Is_Private_Primitive, + Is_Public, + Is_Pure, + Is_Pure_Unit_Access_Type, + Is_RACW_Stub_Type, + Is_Raised, + Is_Remote_Call_Interface, + Is_Remote_Types, + Is_Renaming_Of_Object, + Is_Return_Object, + Is_Safe_To_Reevaluate, + Is_Shared_Passive, + Is_Static_Type, + Is_Statically_Allocated, + Is_Tag, + Is_Tagged_Type, + Is_Thunk, + Is_Trivial_Subprogram, + Is_True_Constant, + Is_Unchecked_Union, + Is_Underlying_Full_View, + Is_Underlying_Record_View, + Is_Unimplemented, + Is_Unsigned_Type, + Is_Uplevel_Referenced_Entity, + Is_Valued_Procedure, + Is_Visible_Formal, + Is_Visible_Lib_Unit, + Is_Volatile_Type, + Is_Volatile_Object, + Is_Volatile_Full_Access, + Itype_Printed, + Kill_Elaboration_Checks, + Kill_Range_Checks, + Known_To_Have_Preelab_Init, + Last_Aggregate_Assignment, + Last_Assignment, + Last_Entity, + Limited_View, + Linker_Section_Pragma, + Lit_Hash, + Lit_Indexes, + Lit_Strings, + Low_Bound_Tested, + Machine_Radix_10, + Master_Id, + Materialize_Entity, + May_Inherit_Delayed_Rep_Aspects, + Mechanism, + Minimum_Accessibility, + Modulus, + Must_Be_On_Byte_Boundary, + Must_Have_Preelab_Init, + Needs_Activation_Record, + Needs_Debug_Info, + Needs_No_Actuals, + Never_Set_In_Source, + Next_Inlined_Subprogram, + No_Dynamic_Predicate_On_Actual, + No_Pool_Assigned, + No_Predicate_On_Actual, + No_Reordering, + No_Return, + No_Strict_Aliasing, + No_Tagged_Streams_Pragma, + Non_Binary_Modulus, + Non_Limited_View, + Nonzero_Is_True, + Normalized_First_Bit, + Normalized_Position, + Normalized_Position_Max, + OK_To_Rename, + Optimize_Alignment_Space, + Optimize_Alignment_Time, + Original_Access_Type, + Original_Array_Type, + Original_Protected_Subprogram, + Original_Record_Component, + Overlays_Constant, + Overridden_Operation, + Package_Instantiation, + Packed_Array_Impl_Type, + Parent_Subtype, + Part_Of_Constituents, + Part_Of_References, + Partial_View_Has_Unknown_Discr, + Pending_Access_Types, + Postconditions_Proc, + Prev_Entity, + Prival, + Prival_Link, + Private_Dependents, + Protected_Body_Subprogram, + Protected_Formal, + Protected_Subprogram, + Protection_Object, + Reachable, + Receiving_Entry, + Referenced, + Referenced_As_LHS, + Referenced_As_Out_Parameter, + Refinement_Constituents, + Register_Exception_Call, + Related_Array_Object, + Related_Expression, + Related_Instance, + Related_Type, + Relative_Deadline_Variable, +-- ??? Renamed_Entity, + Renamed_In_Spec, +-- ??? Renamed_Object, + Renamed_Or_Alias, -- ???Replaces Alias, Renamed_Entity, Renamed_Object + Renaming_Map, + Requires_Overriding, + Return_Applies_To, + Return_Present, + Returns_By_Ref, + Reverse_Bit_Order, + Reverse_Storage_Order, + Rewritten_For_C, + RM_Size, + Scalar_Range, + Scale_Value, + Scope_Depth_Value, + Sec_Stack_Needed_For_Return, + Shared_Var_Procs_Instance, + Size_Check_Code, + Size_Depends_On_Discriminant, + Size_Known_At_Compile_Time, + Small_Value, + SPARK_Aux_Pragma, + SPARK_Aux_Pragma_Inherited, + SPARK_Pragma, + SPARK_Pragma_Inherited, + Spec_Entity, + SSO_Set_High_By_Default, + SSO_Set_Low_By_Default, + Static_Discrete_Predicate, + Static_Elaboration_Desired, + Static_Initialization, + Static_Real_Or_String_Predicate, + Status_Flag_Or_Transient_Decl, + Storage_Size_Variable, + Stored_Constraint, + Stores_Attribute_Old_Prefix, + Strict_Alignment, + String_Literal_Length, + String_Literal_Low_Bound, + Subprograms_For_Type, + Subps_Index, + Suppress_Elaboration_Warnings, + Suppress_Initialization, + Suppress_Style_Checks, + Suppress_Value_Tracking_On_Call, + Task_Body_Procedure, + Thunk_Entity, + Treat_As_Volatile, + Underlying_Full_View, + Underlying_Record_View, + Universal_Aliasing, + Unset_Reference, + Used_As_Generic_Actual, + Uses_Lock_Free, + Uses_Sec_Stack, + Validated_Object, + Warnings_Off, + Warnings_Off_Used, + Warnings_Off_Used_Unmodified, + Warnings_Off_Used_Unreferenced, + Was_Default_Init_Box_Association, + Was_Hidden, + Wrapped_Entity + + -- End of entity fields. + ); -- Opt_Field_Enum + +end Gen_IL.Fields; diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb new file mode 100644 index 00000000000..588d22e302c --- /dev/null +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -0,0 +1,1304 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . G E N . G E N _ E N T I T I E 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. -- +-- -- +------------------------------------------------------------------------------ + +procedure Gen_IL.Gen.Gen_Entities is + + procedure Ab + (T : Abstract_Entity; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + renames Create_Abstract_Entity_Type; + procedure Cc + (T : Concrete_Entity; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + renames Create_Concrete_Entity_Type; + + function Sm + (Field : Field_Enum; Field_Type : Type_Enum; + Type_Only : Type_Only_Enum := No_Type_Only; + Pre : String := "") return Field_Desc + renames Create_Semantic_Field; + + procedure Union (T : Abstract_Entity; Children : Type_Array) + renames Create_Entity_Union; + +begin -- Gen_IL.Gen.Gen_Entities + pragma Style_Checks ("M200"); + + Create_Root_Entity_Type (Entity_Kind, + (Sm (Ekind, Ekind_Type), + Sm (Basic_Convention, Convention_Id), + Sm (Address_Taken, Flag), + Sm (Associated_Entity, Node_Id), + Sm (Can_Never_Be_Null, Flag), + Sm (Checks_May_Be_Suppressed, Flag), + Sm (Debug_Info_Off, Flag), + Sm (Default_Expressions_Processed, Flag), + Sm (Delay_Cleanups, Flag), + Sm (Delay_Subprogram_Descriptors, Flag), + Sm (Depends_On_Private, Flag), + Sm (Disable_Controlled, Flag, Base_Type_Only), + Sm (Discard_Names, Flag), + Sm (First_Rep_Item, Node_Id), + Sm (Freeze_Node, Node_Id), + Sm (From_Limited_With, Flag), + Sm (Has_Aliased_Components, Flag, Impl_Base_Type_Only), + Sm (Has_Alignment_Clause, Flag), + Sm (Has_All_Calls_Remote, Flag), + Sm (Has_Atomic_Components, Flag, Impl_Base_Type_Only), + Sm (Has_Biased_Representation, Flag), + Sm (Has_Completion, Flag), + Sm (Has_Contiguous_Rep, Flag), + Sm (Has_Controlled_Component, Flag, Base_Type_Only), + Sm (Has_Controlling_Result, Flag), + Sm (Has_Convention_Pragma, Flag), + Sm (Has_Default_Aspect, Flag, Base_Type_Only), + Sm (Has_Delayed_Aspects, Flag), + Sm (Has_Delayed_Freeze, Flag), + Sm (Has_Delayed_Rep_Aspects, Flag), + Sm (Has_Exit, Flag), + Sm (Has_Forward_Instantiation, Flag), + Sm (Has_Fully_Qualified_Name, Flag), + Sm (Has_Gigi_Rep_Item, Flag), + Sm (Has_Homonym, Flag), + Sm (Has_Implicit_Dereference, Flag), + Sm (Has_Independent_Components, Flag, Impl_Base_Type_Only), + Sm (Has_Master_Entity, Flag), + Sm (Has_Nested_Block_With_Handler, Flag), + Sm (Has_Non_Standard_Rep, Flag, Impl_Base_Type_Only), + Sm (Has_Per_Object_Constraint, Flag), + Sm (Has_Pragma_Elaborate_Body, Flag), + Sm (Has_Pragma_Inline, Flag), + Sm (Has_Pragma_Inline_Always, Flag), + Sm (Has_Pragma_No_Inline, Flag), + Sm (Has_Pragma_Preelab_Init, Flag), + Sm (Has_Pragma_Pure, Flag), + Sm (Has_Pragma_Pure_Function, Flag), + Sm (Has_Pragma_Thread_Local_Storage, Flag), + Sm (Has_Pragma_Unmodified, Flag), + Sm (Has_Pragma_Unreferenced, Flag), + Sm (Has_Pragma_Unused, Flag), + Sm (Has_Private_Ancestor, Flag), + Sm (Has_Private_Declaration, Flag), + Sm (Has_Protected, Flag, Base_Type_Only), + Sm (Has_Qualified_Name, Flag), + Sm (Has_Size_Clause, Flag), + Sm (Has_Stream_Size_Clause, Flag), + Sm (Has_Task, Flag, Base_Type_Only), + Sm (Has_Timing_Event, Flag, Base_Type_Only), + Sm (Has_Thunks, Flag), + Sm (Has_Unchecked_Union, Flag, Base_Type_Only), + Sm (Has_Volatile_Components, Flag, Impl_Base_Type_Only), + Sm (Has_Xref_Entry, Flag), + Sm (Has_Yield_Aspect, Flag), + Sm (Homonym, Node_Id), + Sm (In_Package_Body, Flag), + Sm (In_Private_Part, Flag), + Sm (In_Use, Flag), + Sm (Is_Ada_2005_Only, Flag), + Sm (Is_Ada_2012_Only, Flag), + Sm (Is_Aliased, Flag), + Sm (Is_Atomic, Flag), + Sm (Is_Bit_Packed_Array, Flag, Impl_Base_Type_Only), + Sm (Is_Character_Type, Flag), + Sm (Is_Checked_Ghost_Entity, Flag), + Sm (Is_Child_Unit, Flag), + Sm (Is_Class_Wide_Clone, Flag), + Sm (Is_Class_Wide_Equivalent_Type, Flag), + Sm (Is_Compilation_Unit, Flag), + Sm (Is_Concurrent_Record_Type, Flag), + Sm (Is_Constr_Subt_For_U_Nominal, Flag), + Sm (Is_Constr_Subt_For_UN_Aliased, Flag), + Sm (Is_Constrained, Flag), + Sm (Is_Constructor, Flag), + Sm (Is_Controlled_Active, Flag, Base_Type_Only), + Sm (Is_CPP_Class, Flag), + Sm (Is_Descendant_Of_Address, Flag), + Sm (Is_Discrim_SO_Function, Flag), + Sm (Is_Discriminant_Check_Function, Flag), + Sm (Is_Dispatch_Table_Entity, Flag), + Sm (Is_Dispatching_Operation, Flag), + Sm (Is_Eliminated, Flag), + Sm (Is_Entry_Formal, Flag), + Sm (Is_Entry_Wrapper, Flag), + Sm (Is_Exported, Flag), + Sm (Is_First_Subtype, Flag), + Sm (Is_Formal_Subprogram, Flag), + Sm (Is_Frozen, Flag), + Sm (Is_Generic_Instance, Flag), + Sm (Is_Generic_Type, Flag), + Sm (Is_Hidden, Flag), + Sm (Is_Hidden_Non_Overridden_Subpgm, Flag), + Sm (Is_Hidden_Open_Scope, Flag), + Sm (Is_Ignored_Ghost_Entity, Flag), + Sm (Is_Immediately_Visible, Flag), + Sm (Is_Implementation_Defined, Flag), + Sm (Is_Imported, Flag), + Sm (Is_Independent, Flag), + Sm (Is_Inlined, Flag), + Sm (Is_Instantiated, Flag), + Sm (Is_Interface, Flag), + Sm (Is_Internal, Flag), + Sm (Is_Interrupt_Handler, Flag), + Sm (Is_Intrinsic_Subprogram, Flag), + Sm (Is_Itype, Flag), + Sm (Is_Known_Non_Null, Flag), + Sm (Is_Known_Null, Flag), + Sm (Is_Known_Valid, Flag), + Sm (Is_Limited_Composite, Flag), + Sm (Is_Limited_Interface, Flag), + Sm (Is_Limited_Record, Flag), + Sm (Is_Loop_Parameter, Flag), + Sm (Is_Obsolescent, Flag), + Sm (Is_Package_Body_Entity, Flag), + Sm (Is_Packed, Flag, Impl_Base_Type_Only), + Sm (Is_Packed_Array_Impl_Type, Flag), + Sm (Is_Potentially_Use_Visible, Flag), + Sm (Is_Preelaborated, Flag), + Sm (Is_Private_Descendant, Flag), + Sm (Is_Public, Flag), + Sm (Is_Pure, Flag), + Sm (Is_Remote_Call_Interface, Flag), + Sm (Is_Remote_Types, Flag), + Sm (Is_Renaming_Of_Object, Flag), + Sm (Is_Return_Object, Flag), + Sm (Is_Safe_To_Reevaluate, Flag), + Sm (Is_Shared_Passive, Flag), + Sm (Is_Static_Type, Flag), + Sm (Is_Statically_Allocated, Flag), + Sm (Is_Tag, Flag), + Sm (Is_Tagged_Type, Flag), + Sm (Is_Thunk, Flag), + Sm (Is_Trivial_Subprogram, Flag), + Sm (Is_True_Constant, Flag), + Sm (Is_Unchecked_Union, Flag, Impl_Base_Type_Only), + Sm (Is_Underlying_Full_View, Flag), + Sm (Is_Underlying_Record_View, Flag, Base_Type_Only), + Sm (Is_Unimplemented, Flag), + Sm (Is_Uplevel_Referenced_Entity, Flag), + Sm (Is_Visible_Formal, Flag), + Sm (Is_Visible_Lib_Unit, Flag), + Sm (Is_Volatile_Type, Flag), -- Should be Base_Type_Only????? + Sm (Is_Volatile_Object, Flag), + Sm (Is_Volatile_Full_Access, Flag), + Sm (Kill_Elaboration_Checks, Flag), + Sm (Kill_Range_Checks, Flag), + Sm (Low_Bound_Tested, Flag), + Sm (Materialize_Entity, Flag), + Sm (May_Inherit_Delayed_Rep_Aspects, Flag), + Sm (Needs_Activation_Record, Flag), + Sm (Needs_Debug_Info, Flag), + Sm (Never_Set_In_Source, Flag), + Sm (No_Return, Flag), + Sm (Overlays_Constant, Flag), + Sm (Prev_Entity, Node_Id), + Sm (Reachable, Flag), + Sm (Referenced, Flag), + Sm (Referenced_As_LHS, Flag), + Sm (Referenced_As_Out_Parameter, Flag), + Sm (Return_Present, Flag), + Sm (Returns_By_Ref, Flag), + Sm (Sec_Stack_Needed_For_Return, Flag), + Sm (Size_Depends_On_Discriminant, Flag), + Sm (Size_Known_At_Compile_Time, Flag), + Sm (Stores_Attribute_Old_Prefix, Flag), + Sm (Strict_Alignment, Flag, Impl_Base_Type_Only), + Sm (Suppress_Elaboration_Warnings, Flag), + Sm (Suppress_Style_Checks, Flag), + Sm (Suppress_Value_Tracking_On_Call, Flag), + Sm (Treat_As_Volatile, Flag), + Sm (Used_As_Generic_Actual, Flag), + Sm (Uses_Sec_Stack, Flag), + Sm (Warnings_Off, Flag), + Sm (Warnings_Off_Used, Flag), + Sm (Warnings_Off_Used_Unmodified, Flag), + Sm (Warnings_Off_Used_Unreferenced, Flag), + Sm (Was_Hidden, Flag))); + + Cc (E_Void, Entity_Kind, + (Sm (Alignment, Uint), + Sm (Contract, Node_Id), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Original_Record_Component, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag), + Sm (Corresponding_Protected_Entry, Node_Id), -- setter only + Sm (Current_Value, Node_Id), -- setter only + Sm (Has_Predicates, Flag), -- setter only + Sm (Initialization_Statements, Node_Id), -- setter only + Sm (Is_Param_Block_Component_Type, Flag, Base_Type_Only), -- setter only + Sm (Package_Instantiation, Node_Id), -- setter only + Sm (Related_Expression, Node_Id), -- setter only + + -- ????The following are not documented in the old einfo.ads as being + -- fields of E_Void. + Sm (Accept_Address, Elist_Id), + Sm (Associated_Formal_Package, Node_Id), + Sm (Associated_Node_For_Itype, Node_Id), + Sm (Corresponding_Remote_Type, Node_Id), + Sm (CR_Discriminant, Node_Id), + Sm (Debug_Renaming_Link, Node_Id), + Sm (Directly_Designated_Type, Node_Id), + Sm (Discriminal_Link, Node_Id), + Sm (Discriminant_Default_Value, Node_Id), + Sm (Discriminant_Number, Uint), + Sm (Enclosing_Scope, Node_Id), + Sm (Entry_Bodies_Array, Node_Id, + Pre => "Has_Entries (N)"), -- This can't be right???? + Sm (Entry_Cancel_Parameter, Node_Id), + Sm (Entry_Component, Node_Id), + Sm (Entry_Formal, Node_Id), + Sm (Entry_Parameters_Type, Node_Id), + Sm (Esize, Uint), + Sm (RM_Size, Uint), + Sm (Extra_Formal, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Float_Rep, Float_Rep_Kind, Base_Type_Only), + Sm (Generic_Homonym, Node_Id), + Sm (Generic_Renamings, Elist_Id), + Sm (Handler_Records, List_Id), +-- ???? Sm (Has_Protected, Flag), + Sm (Has_Static_Discriminants, Flag), + Sm (Inner_Instances, Elist_Id), + Sm (Interface_Name, Node_Id), + Sm (Last_Entity, Node_Id), + Sm (Next_Inlined_Subprogram, Node_Id), + Sm (Renamed_Or_Alias, Node_Id), -- See Einfo.Utils + Sm (Renaming_Map, Uint), + Sm (Return_Applies_To, Node_Id), + Sm (Scalar_Range, Node_Id), + Sm (Scale_Value, Uint), + Sm (Unset_Reference, Node_Id))); + -- In the previous version, the above "setter only" fields were allowed for + -- E_Void only on the setters, not getters. + + -- ????This comment in the old version of einfo.adb: + + -- Note: in many of these set procedures an "obvious" assertion is missing. + -- The reason for this is that in many cases, a field is set before the + -- Ekind field is set, so that the field is set when Ekind = E_Void. It + -- it is possible to add assertions that specifically include the E_Void + -- possibility, but in some cases, we just omit the assertions. + + -- causes a lot of headaches. Plus some places used the low-level setters + -- (e.g. Set_Node1), which bypasses any assertions. + + Ab (Object_Kind, Entity_Kind, + (Sm (Current_Value, Node_Id), + Sm (Renamed_Or_Alias, Node_Id))); + + Cc (E_Component, Object_Kind, + (Sm (Component_Bit_Offset, Uint), + Sm (Component_Clause, Node_Id), + Sm (Corresponding_Record_Component, Node_Id), + Sm (Discriminant_Checking_Func, Node_Id), + Sm (DT_Entry_Count, Uint, + Pre => "Is_Tag (N)"), + Sm (DT_Offset_To_Top_Func, Node_Id, + Pre => "Is_Tag (N)"), + Sm (Entry_Formal, Node_Id), + Sm (Esize, Uint), + Sm (Interface_Name, Node_Id), + Sm (Linker_Section_Pragma, Node_Id), + Sm (Normalized_First_Bit, Uint), + Sm (Normalized_Position, Uint), + Sm (Normalized_Position_Max, Uint), + Sm (Original_Record_Component, Node_Id), + Sm (Prival, Node_Id, + Pre => "Is_Protected_Component (N)"), + Sm (Related_Type, Node_Id))); + + Cc (E_Constant, Object_Kind, + (Sm (Activation_Record_Component, Node_Id), + Sm (Actual_Subtype, Node_Id), + Sm (Alignment, Uint), + Sm (BIP_Initialization_Call, Node_Id), + Sm (Contract, Node_Id), + Sm (Discriminal_Link, Node_Id), + Sm (Encapsulating_State, Node_Id), + Sm (Esize, Uint), + Sm (Extra_Accessibility, Node_Id), + Sm (Full_View, Node_Id), + Sm (Initialization_Statements, Node_Id), + Sm (Interface_Name, Node_Id), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Is_Finalized_Transient, Flag), + Sm (Is_Ignored_Transient, Flag), + Sm (Last_Aggregate_Assignment, Node_Id), + Sm (Linker_Section_Pragma, Node_Id), + Sm (Optimize_Alignment_Space, Flag), + Sm (Optimize_Alignment_Time, Flag), + Sm (Prival_Link, Node_Id), + Sm (Related_Expression, Node_Id), + Sm (Related_Type, Node_Id), + Sm (Size_Check_Code, Node_Id), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag), + Sm (Status_Flag_Or_Transient_Decl, Node_Id))); + + Cc (E_Discriminant, Object_Kind, + (Sm (Component_Bit_Offset, Uint), + Sm (Component_Clause, Node_Id), + Sm (Corresponding_Discriminant, Node_Id), + Sm (Corresponding_Record_Component, Node_Id), + Sm (CR_Discriminant, Node_Id), + Sm (Discriminal, Node_Id), + Sm (Discriminant_Default_Value, Node_Id), + Sm (Discriminant_Number, Uint), + Sm (Entry_Formal, Node_Id), + Sm (Esize, Uint), + Sm (Interface_Name, Node_Id), + Sm (Is_Completely_Hidden, Flag), + Sm (Linker_Section_Pragma, Node_Id), + Sm (Normalized_First_Bit, Uint), + Sm (Normalized_Position, Uint), + Sm (Normalized_Position_Max, Uint), + Sm (Original_Record_Component, Node_Id))); + + Cc (E_Loop_Parameter, Object_Kind, + (Sm (Activation_Record_Component, Node_Id), + Sm (Alignment, Uint), + Sm (Esize, Uint), + Sm (Is_Finalized_Transient, Flag), + Sm (Is_Ignored_Transient, Flag), + Sm (Linker_Section_Pragma, Node_Id), + Sm (Related_Expression, Node_Id), + Sm (Status_Flag_Or_Transient_Decl, Node_Id))); + + Cc (E_Variable, Object_Kind, + (Sm (Activation_Record_Component, Node_Id), + Sm (Actual_Subtype, Node_Id), + Sm (Alignment, Uint), + Sm (Anonymous_Designated_Type, Node_Id), + Sm (BIP_Initialization_Call, Node_Id), + Sm (Contract, Node_Id), + Sm (Debug_Renaming_Link, Node_Id), + Sm (Discriminal_Link, Node_Id), + Sm (Encapsulating_State, Node_Id), + Sm (Esize, Uint), + Sm (Extra_Accessibility, Node_Id), + Sm (Extra_Constrained, Node_Id), + Sm (Has_Initial_Value, Flag), + Sm (Hiding_Loop_Variable, Node_Id), + Sm (Initialization_Statements, Node_Id), + Sm (Interface_Name, Node_Id), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Is_Finalized_Transient, Flag), + Sm (Is_Ignored_Transient, Flag), + Sm (Last_Aggregate_Assignment, Node_Id), + Sm (Last_Assignment, Node_Id), + Sm (Linker_Section_Pragma, Node_Id), + Sm (OK_To_Rename, Flag), + Sm (Optimize_Alignment_Space, Flag), + Sm (Optimize_Alignment_Time, Flag), + Sm (Part_Of_Constituents, Elist_Id), + Sm (Part_Of_References, Elist_Id), + Sm (Prival_Link, Node_Id), + Sm (Related_Expression, Node_Id), + Sm (Related_Type, Node_Id), + Sm (Shared_Var_Procs_Instance, Node_Id), + Sm (Size_Check_Code, Node_Id), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag), + Sm (Status_Flag_Or_Transient_Decl, Node_Id), + Sm (Suppress_Initialization, Flag), + Sm (Unset_Reference, Node_Id), + Sm (Validated_Object, Node_Id))); + + Ab (Formal_Kind, Object_Kind, + (Sm (Activation_Record_Component, Node_Id), + Sm (Actual_Subtype, Node_Id), + Sm (Alignment, Uint), + Sm (Default_Expr_Function, Node_Id), + Sm (Default_Value, Node_Id), + Sm (Entry_Component, Node_Id), + Sm (Esize, Uint), + Sm (Extra_Accessibility, Node_Id), + Sm (Extra_Constrained, Node_Id), + Sm (Extra_Formal, Node_Id), + Sm (Has_Initial_Value, Flag), + Sm (Is_Controlling_Formal, Flag), + Sm (Is_Only_Out_Parameter, Flag), + Sm (Linker_Section_Pragma, Node_Id), + Sm (Mechanism, Mechanism_Type), + Sm (Minimum_Accessibility, Node_Id), + Sm (Protected_Formal, Node_Id), + Sm (Spec_Entity, Node_Id), + Sm (Unset_Reference, Node_Id))); + + Cc (E_Out_Parameter, Formal_Kind, + (Sm (Last_Assignment, Node_Id))); + + Cc (E_In_Out_Parameter, Formal_Kind, + (Sm (Last_Assignment, Node_Id))); + + Cc (E_In_Parameter, Formal_Kind, + (Sm (Discriminal_Link, Node_Id), + Sm (Discriminant_Default_Value, Node_Id), + Sm (Is_Activation_Record, Flag))); + + Ab (Formal_Object_Kind, Object_Kind, + (Sm (Entry_Component, Node_Id), + Sm (Esize, Uint))); + + Cc (E_Generic_In_Out_Parameter, Formal_Object_Kind, + (Sm (Actual_Subtype, Node_Id))); + + Cc (E_Generic_In_Parameter, Formal_Object_Kind); + + Ab (Named_Kind, Entity_Kind, + (Sm (Renamed_Or_Alias, Node_Id))); + + Cc (E_Named_Integer, Named_Kind); + + Cc (E_Named_Real, Named_Kind); + + Ab (Type_Kind, Entity_Kind, + (Sm (Alignment, Uint), + Sm (Associated_Node_For_Itype, Node_Id), + Sm (Can_Use_Internal_Rep, Flag, Base_Type_Only, + Pre => "Is_Access_Subprogram_Type (Base_Type (N))"), + Sm (Class_Wide_Type, Node_Id), + Sm (Contract, Node_Id), + Sm (Current_Use_Clause, Node_Id), + Sm (Derived_Type_Link, Node_Id), + Sm (Predicates_Ignored, Flag), + Sm (Esize, Uint), + Sm (Finalize_Storage_Only, Flag, Base_Type_Only), + Sm (Full_View, Node_Id), + Sm (Has_Completion_In_Body, Flag), + Sm (Has_Constrained_Partial_View, Flag, Base_Type_Only), + Sm (Has_Discriminants, Flag), + Sm (Has_Dispatch_Table, Flag, + Pre => "Is_Tagged_Type (N)"), + Sm (Has_Dynamic_Predicate_Aspect, Flag), + Sm (Has_Inheritable_Invariants, Flag, Base_Type_Only), + Sm (Has_Inherited_DIC, Flag, Base_Type_Only), + Sm (Has_Inherited_Invariants, Flag, Base_Type_Only), + Sm (Has_Object_Size_Clause, Flag), + Sm (Has_Own_DIC, Flag, Base_Type_Only), + Sm (Has_Own_Invariants, Flag, Base_Type_Only), + Sm (Has_Pragma_Unreferenced_Objects, Flag), + Sm (Has_Predicates, Flag), + Sm (Has_Primitive_Operations, Flag, Base_Type_Only), + Sm (Has_Private_Extension, Flag, + Pre => "Is_Tagged_Type (N)"), + Sm (Has_Specified_Layout, Flag, Impl_Base_Type_Only), + Sm (Has_Specified_Stream_Input, Flag), + Sm (Has_Specified_Stream_Output, Flag), + Sm (Has_Specified_Stream_Read, Flag), + Sm (Has_Specified_Stream_Write, Flag), + Sm (Has_Static_Discriminants, Flag), + Sm (Has_Static_Predicate, Flag), + Sm (Has_Static_Predicate_Aspect, Flag), + Sm (Has_Unknown_Discriminants, Flag), + Sm (Interface_Name, Node_Id), + Sm (Is_Abstract_Type, Flag), + Sm (Is_Actual_Subtype, Flag), + Sm (Is_Asynchronous, Flag), + Sm (Is_Generic_Actual_Type, Flag), + Sm (Is_Non_Static_Subtype, Flag), + Sm (Is_Private_Composite, Flag), + Sm (Is_RACW_Stub_Type, Flag), + Sm (Is_Unsigned_Type, Flag), + Sm (Itype_Printed, Flag, + Pre => "Is_Itype (N)"), + Sm (Known_To_Have_Preelab_Init, Flag), + Sm (Linker_Section_Pragma, Node_Id), + Sm (Must_Be_On_Byte_Boundary, Flag), + Sm (Must_Have_Preelab_Init, Flag), + Sm (No_Tagged_Streams_Pragma, Node_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Non_Binary_Modulus, Flag, Base_Type_Only), + Sm (Optimize_Alignment_Space, Flag), + Sm (Optimize_Alignment_Time, Flag), + Sm (Partial_View_Has_Unknown_Discr, Flag), + Sm (Pending_Access_Types, Elist_Id), + Sm (Related_Expression, Node_Id), + Sm (RM_Size, Uint), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag), + Sm (Subprograms_For_Type, Elist_Id), + Sm (Suppress_Initialization, Flag), + Sm (Universal_Aliasing, Flag, Impl_Base_Type_Only), + Sm (Renamed_Or_Alias, Node_Id))); + + Ab (Elementary_Kind, Type_Kind); + + Ab (Scalar_Kind, Elementary_Kind, + (Sm (Default_Aspect_Value, Node_Id, Base_Type_Only), + Sm (Scalar_Range, Node_Id))); + + Ab (Discrete_Kind, Scalar_Kind, + (Sm (No_Dynamic_Predicate_On_Actual, Flag), + Sm (No_Predicate_On_Actual, Flag), + Sm (Static_Discrete_Predicate, List_Id))); + + Ab (Enumeration_Kind, Discrete_Kind, + (Sm (First_Literal, Node_Id), + Sm (Has_Enumeration_Rep_Clause, Flag), + Sm (Has_Pragma_Ordered, Flag, Impl_Base_Type_Only), + Sm (Lit_Indexes, Node_Id), + Sm (Lit_Strings, Node_Id), + Sm (Nonzero_Is_True, Flag, Base_Type_Only, + Pre => "Root_Type (N) = Standard_Boolean"), + Sm (Lit_Hash, Node_Id, Root_Type_Only))); + + Cc (E_Enumeration_Type, Enumeration_Kind, + (Sm (Enum_Pos_To_Rep, Node_Id), + Sm (First_Entity, Node_Id))); + + Cc (E_Enumeration_Subtype, Enumeration_Kind); + + Ab (Integer_Kind, Discrete_Kind, + (Sm (Has_Shift_Operator, Flag, Base_Type_Only))); + + Ab (Signed_Integer_Kind, Integer_Kind, + (Sm (First_Entity, Node_Id))); + + Cc (E_Signed_Integer_Type, Signed_Integer_Kind, + (Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"))); + + Cc (E_Signed_Integer_Subtype, Signed_Integer_Kind); + + Ab (Modular_Integer_Kind, Integer_Kind, + (Sm (Modulus, Uint, Base_Type_Only), + Sm (Original_Array_Type, Node_Id))); + + Cc (E_Modular_Integer_Type, Modular_Integer_Kind); + + Cc (E_Modular_Integer_Subtype, Modular_Integer_Kind); + + Ab (Real_Kind, Scalar_Kind, + (Sm (Static_Real_Or_String_Predicate, Node_Id))); + + Ab (Fixed_Point_Kind, Real_Kind, + (Sm (Delta_Value, Ureal), + Sm (Small_Value, Ureal))); + + Ab (Ordinary_Fixed_Point_Kind, Fixed_Point_Kind, + (Sm (Has_Small_Clause, Flag))); + + Cc (E_Ordinary_Fixed_Point_Type, Ordinary_Fixed_Point_Kind); + + Cc (E_Ordinary_Fixed_Point_Subtype, Ordinary_Fixed_Point_Kind); + + Ab (Decimal_Fixed_Point_Kind, Fixed_Point_Kind, + (Sm (Digits_Value, Uint), + Sm (Has_Machine_Radix_Clause, Flag), + Sm (Machine_Radix_10, Flag), + Sm (Scale_Value, Uint))); + + Cc (E_Decimal_Fixed_Point_Type, Decimal_Fixed_Point_Kind); + + Cc (E_Decimal_Fixed_Point_Subtype, Decimal_Fixed_Point_Kind); + + Ab (Float_Kind, Real_Kind, + (Sm (Digits_Value, Uint), + Sm (Float_Rep, Float_Rep_Kind, Base_Type_Only))); + + Cc (E_Floating_Point_Type, Float_Kind); + + Cc (E_Floating_Point_Subtype, Float_Kind); + + Ab (Access_Kind, Elementary_Kind, + (Sm (Associated_Storage_Pool, Node_Id, Root_Type_Only), + Sm (Directly_Designated_Type, Node_Id), + Sm (Finalization_Master, Node_Id, Root_Type_Only), + Sm (Has_Pragma_Controlled, Flag, Impl_Base_Type_Only), + Sm (Has_Storage_Size_Clause, Flag, Impl_Base_Type_Only), + Sm (Is_Access_Constant, Flag), + Sm (Is_Local_Anonymous_Access, Flag), + Sm (Is_Param_Block_Component_Type, Flag, Base_Type_Only), + Sm (Is_Pure_Unit_Access_Type, Flag), + Sm (Master_Id, Node_Id), + Sm (No_Pool_Assigned, Flag, Root_Type_Only), + Sm (No_Strict_Aliasing, Flag, Base_Type_Only), + Sm (Storage_Size_Variable, Node_Id, Impl_Base_Type_Only))); + + Cc (E_Access_Type, Access_Kind, + (Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"))); + + Cc (E_Access_Subtype, Access_Kind); + + Cc (E_Access_Attribute_Type, Access_Kind); + + Cc (E_Allocator_Type, Access_Kind); + + Cc (E_General_Access_Type, Access_Kind, + (Sm (First_Entity, Node_Id))); + + Ab (Access_Subprogram_Kind, Access_Kind); + + Cc (E_Access_Subprogram_Type, Access_Subprogram_Kind, + (Sm (Equivalent_Type, Node_Id), + Sm (Original_Access_Type, Node_Id))); + + Ab (Access_Protected_Kind, Access_Subprogram_Kind, + (Sm (Equivalent_Type, Node_Id))); + + Cc (E_Access_Protected_Subprogram_Type, Access_Protected_Kind); + + Cc (E_Anonymous_Access_Protected_Subprogram_Type, Access_Protected_Kind); + + Cc (E_Anonymous_Access_Subprogram_Type, Access_Subprogram_Kind); + + Cc (E_Anonymous_Access_Type, Access_Kind); + + Ab (Composite_Kind, Type_Kind, +-- ????This fails for the same reason as DT_Position of E_Function; +-- see comment there. +-- (Sm (Discriminant_Constraint, Elist_Id, +-- Pre => "Has_Discriminants (N) or else Is_Constrained (N)"))); + (Sm (Discriminant_Constraint, Elist_Id))); + + Ab (Aggregate_Kind, Composite_Kind, + (Sm (Component_Alignment, Component_Alignment_Kind, Base_Type_Only), + Sm (Has_Pragma_Pack, Flag, Impl_Base_Type_Only), + Sm (Reverse_Storage_Order, Flag, Base_Type_Only), + Sm (SSO_Set_High_By_Default, Flag, Base_Type_Only), + Sm (SSO_Set_Low_By_Default, Flag, Base_Type_Only))); + + Ab (Array_Kind, Aggregate_Kind, + (Sm (Component_Size, Uint, Impl_Base_Type_Only), + Sm (Component_Type, Node_Id, Impl_Base_Type_Only), + Sm (Default_Aspect_Component_Value, Node_Id, Base_Type_Only), + Sm (First_Index, Node_Id), + Sm (Has_Component_Size_Clause, Flag, Impl_Base_Type_Only), + Sm (Original_Array_Type, Node_Id), + Sm (Packed_Array_Impl_Type, Node_Id), + Sm (Related_Array_Object, Node_Id))); + + Cc (E_Array_Type, Array_Kind, + (Sm (First_Entity, Node_Id), + Sm (Static_Real_Or_String_Predicate, Node_Id))); + + Cc (E_Array_Subtype, Array_Kind, + (Sm (Predicated_Parent, Node_Id), + Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (First_Entity, Node_Id), + Sm (Static_Real_Or_String_Predicate, Node_Id))); + + Cc (E_String_Literal_Subtype, Array_Kind, + (Sm (String_Literal_Length, Uint), + Sm (String_Literal_Low_Bound, Node_Id))); + + Ab (Class_Wide_Kind, Aggregate_Kind, + (Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only), + Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Equivalent_Type, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), + Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), + Sm (Interfaces, Elist_Id), + Sm (Last_Entity, Node_Id), + Sm (No_Reordering, Flag, Impl_Base_Type_Only), + Sm (Non_Limited_View, Node_Id), + Sm (Parent_Subtype, Node_Id, Base_Type_Only), + Sm (Reverse_Bit_Order, Flag, Base_Type_Only), + Sm (Stored_Constraint, Elist_Id))); + + Cc (E_Class_Wide_Type, Class_Wide_Kind, + (Sm (Corresponding_Remote_Type, Node_Id), + Sm (Scalar_Range, Node_Id))); + + Cc (E_Class_Wide_Subtype, Class_Wide_Kind, + (Sm (Cloned_Subtype, Node_Id))); + + Cc (E_Record_Type, Aggregate_Kind, + (Sm (Access_Disp_Table, Elist_Id, Impl_Base_Type_Only), + Sm (Access_Disp_Table_Elab_Flag, Node_Id, Impl_Base_Type_Only), + Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only), + Sm (Corresponding_Concurrent_Type, Node_Id), + Sm (Corresponding_Remote_Type, Node_Id), + Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Dispatch_Table_Wrappers, Elist_Id, Impl_Base_Type_Only), + Sm (First_Entity, Node_Id), + Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), + Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), + Sm (Interfaces, Elist_Id), + Sm (Last_Entity, Node_Id), + Sm (No_Reordering, Flag, Impl_Base_Type_Only), + Sm (Parent_Subtype, Node_Id, Base_Type_Only), + Sm (Reverse_Bit_Order, Flag, Base_Type_Only), + Sm (Stored_Constraint, Elist_Id), + Sm (Underlying_Record_View, Node_Id))); + + Cc (E_Record_Subtype, Aggregate_Kind, + (Sm (Access_Disp_Table, Elist_Id, Impl_Base_Type_Only), + Sm (Access_Disp_Table_Elab_Flag, Node_Id, Impl_Base_Type_Only), + Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only), + Sm (Cloned_Subtype, Node_Id), + Sm (Corresponding_Remote_Type, Node_Id), + Sm (Predicated_Parent, Node_Id), + Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Dispatch_Table_Wrappers, Elist_Id, Impl_Base_Type_Only), + Sm (First_Entity, Node_Id), + Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), + Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), + Sm (Interfaces, Elist_Id), + Sm (Last_Entity, Node_Id), + Sm (No_Reordering, Flag, Impl_Base_Type_Only), + Sm (Parent_Subtype, Node_Id, Base_Type_Only), + Sm (Reverse_Bit_Order, Flag, Base_Type_Only), + Sm (Stored_Constraint, Elist_Id), + Sm (Underlying_Record_View, Node_Id))); + + Ab (Incomplete_Or_Private_Kind, Composite_Kind, + (Sm (First_Entity, Node_Id), + Sm (Last_Entity, Node_Id), + Sm (Private_Dependents, Elist_Id), + Sm (Stored_Constraint, Elist_Id))); + + Ab (Private_Kind, Incomplete_Or_Private_Kind, + (Sm (Underlying_Full_View, Node_Id))); + + Cc (E_Record_Type_With_Private, Private_Kind, + (Sm (Access_Disp_Table, Elist_Id, Impl_Base_Type_Only), + Sm (Access_Disp_Table_Elab_Flag, Node_Id, Impl_Base_Type_Only), + Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only), + Sm (Component_Alignment, Component_Alignment_Kind, Base_Type_Only), + Sm (Corresponding_Remote_Type, Node_Id), + Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), + Sm (Has_Pragma_Pack, Flag, Impl_Base_Type_Only), + Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), + Sm (Interfaces, Elist_Id), + Sm (No_Reordering, Flag, Impl_Base_Type_Only), + Sm (Parent_Subtype, Node_Id, Base_Type_Only), + Sm (Reverse_Bit_Order, Flag, Base_Type_Only), + Sm (Reverse_Storage_Order, Flag, Base_Type_Only), + Sm (SSO_Set_High_By_Default, Flag, Base_Type_Only), + Sm (SSO_Set_Low_By_Default, Flag, Base_Type_Only), + Sm (Underlying_Record_View, Node_Id))); + + Cc (E_Record_Subtype_With_Private, Private_Kind, + (Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only), + Sm (Component_Alignment, Component_Alignment_Kind, Base_Type_Only), + Sm (Corresponding_Remote_Type, Node_Id), + Sm (Predicated_Parent, Node_Id), + Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), + Sm (Has_Pragma_Pack, Flag, Impl_Base_Type_Only), + Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), + Sm (Interfaces, Elist_Id), + Sm (No_Reordering, Flag, Impl_Base_Type_Only), + Sm (Parent_Subtype, Node_Id, Base_Type_Only), + Sm (Reverse_Bit_Order, Flag, Base_Type_Only), + Sm (Reverse_Storage_Order, Flag, Base_Type_Only), + Sm (SSO_Set_High_By_Default, Flag, Base_Type_Only), + Sm (SSO_Set_Low_By_Default, Flag, Base_Type_Only))); + + Cc (E_Private_Type, Private_Kind, + (Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Scalar_Range, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (Directly_Designated_Type, Node_Id))); + -- ????Directly_Designated_Type was allowed to be Set_, but not get. + -- Same for E_Limited_Private_Type. And incomplete. + + Cc (E_Private_Subtype, Private_Kind, + (Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Scope_Depth_Value, Uint))); + + Cc (E_Limited_Private_Type, Private_Kind, + (Sm (Scalar_Range, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (Directly_Designated_Type, Node_Id))); + + Cc (E_Limited_Private_Subtype, Private_Kind, + (Sm (Scope_Depth_Value, Uint))); + + Ab (Incomplete_Kind, Incomplete_Or_Private_Kind, + (Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (Non_Limited_View, Node_Id), + Sm (Directly_Designated_Type, Node_Id))); + + Cc (E_Incomplete_Type, Incomplete_Kind, + (Sm (Scalar_Range, Node_Id))); + + Cc (E_Incomplete_Subtype, Incomplete_Kind); + + Ab (Concurrent_Kind, Composite_Kind, + (Sm (Corresponding_Record_Type, Node_Id), + Sm (Direct_Primitive_Operations, Elist_Id, + Pre => "Is_Tagged_Type (N)"), + Sm (First_Entity, Node_Id), + Sm (First_Private_Entity, Node_Id), + Sm (Last_Entity, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (Stored_Constraint, Elist_Id))); + + Ab (Task_Kind, Concurrent_Kind, + (Sm (Has_Storage_Size_Clause, Flag, Impl_Base_Type_Only), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Relative_Deadline_Variable, Node_Id, Impl_Base_Type_Only), + Sm (Storage_Size_Variable, Node_Id, Impl_Base_Type_Only), + Sm (Task_Body_Procedure, Node_Id))); + + Cc (E_Task_Type, Task_Kind, + (Sm (Anonymous_Object, Node_Id), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (SPARK_Aux_Pragma, Node_Id), + Sm (SPARK_Aux_Pragma_Inherited, Flag))); + + Cc (E_Task_Subtype, Task_Kind); + + Ab (Protected_Kind, Concurrent_Kind, + (Sm (Entry_Bodies_Array, Node_Id, + Pre => "Has_Entries (N)"), + Sm (Uses_Lock_Free, Flag))); + + Cc (E_Protected_Type, Protected_Kind, + (Sm (Anonymous_Object, Node_Id), + Sm (Entry_Max_Queue_Lengths_Array, Node_Id), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (SPARK_Aux_Pragma, Node_Id), + Sm (SPARK_Aux_Pragma_Inherited, Flag))); + + Cc (E_Protected_Subtype, Protected_Kind); + + Cc (E_Exception_Type, Type_Kind, + (Sm (Equivalent_Type, Node_Id))); + + Cc (E_Subprogram_Type, Type_Kind, + (Sm (Access_Subprogram_Wrapper, Node_Id), + Sm (Extra_Accessibility_Of_Result, Node_Id), + Sm (Extra_Formals, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Last_Entity, Node_Id), + Sm (Needs_No_Actuals, Flag))); + + Ab (Overloadable_Kind, Entity_Kind, + (Sm (Renamed_Or_Alias, Node_Id), + Sm (Extra_Formals, Node_Id), + Sm (Is_Abstract_Subprogram, Flag), + Sm (Is_Primitive, Flag), + Sm (Needs_No_Actuals, Flag), + Sm (Requires_Overriding, Flag))); + + Cc (E_Enumeration_Literal, Overloadable_Kind, + (Sm (Enumeration_Pos, Uint), + Sm (Enumeration_Rep, Uint), + Sm (Enumeration_Rep_Expr, Node_Id), + Sm (Esize, Uint), + Sm (Alignment, Uint), + Sm (Interface_Name, Node_Id))); + + Ab (Subprogram_Kind, Overloadable_Kind, + (Sm (Body_Needed_For_SAL, Flag), + Sm (Class_Wide_Clone, Node_Id), + Sm (Contract, Node_Id), + Sm (Elaboration_Entity, Node_Id), + Sm (Elaboration_Entity_Required, Flag), + Sm (First_Entity, Node_Id), + Sm (Has_Expanded_Contract, Flag), + Sm (Has_Nested_Subprogram, Flag), + Sm (Has_Out_Or_In_Out_Parameter, Flag), + Sm (Has_Recursive_Call, Flag), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (Import_Pragma, Node_Id), + Sm (Interface_Alias, Node_Id), + Sm (Interface_Name, Node_Id), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Is_Machine_Code_Subprogram, Flag), + Sm (Last_Entity, Node_Id), + Sm (Linker_Section_Pragma, Node_Id), + Sm (Overridden_Operation, Node_Id), + Sm (Protected_Body_Subprogram, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag), + Sm (Subps_Index, Uint))); + + Cc (E_Function, Subprogram_Kind, + (Sm (Anonymous_Masters, Elist_Id), + Sm (Corresponding_Equality, Node_Id, + Pre => "not Comes_From_Source (N) and then Chars (N) = Name_Op_Ne"), + Sm (Corresponding_Procedure, Node_Id), +-- ????In the old version, we had the following assertion in the getter, but +-- not the setter, and in fact we sometimes violate it in the setter, for +-- example, sem_disp.adb:1635 says "Set_DT_Position_Value (Subp, No_Uint);". +-- Sm (DT_Position, Uint, +-- Pre => "Present (DTC_Entity (N))"), +-- Perhaps we should have "getter-only preconditions". + Sm (DT_Position, Uint), + Sm (DTC_Entity, Node_Id), + Sm (Extra_Accessibility_Of_Result, Node_Id), + Sm (Generic_Renamings, Elist_Id), + Sm (Handler_Records, List_Id), + Sm (Has_Missing_Return, Flag), + Sm (Inner_Instances, Elist_Id), + Sm (Is_Called, Flag), + Sm (Is_CUDA_Kernel, Flag), + Sm (Is_DIC_Procedure, Flag), + Sm (Is_Generic_Actual_Subprogram, Flag), + Sm (Is_Initial_Condition_Procedure, Flag), + Sm (Is_Inlined_Always, Flag), + Sm (Is_Invariant_Procedure, Flag), + Sm (Is_Partial_Invariant_Procedure, Flag), + Sm (Is_Predicate_Function, Flag), + Sm (Is_Predicate_Function_M, Flag), + Sm (Is_Primitive_Wrapper, Flag), + Sm (Is_Private_Primitive, Flag), + Sm (Mechanism, Mechanism_Type), + Sm (Next_Inlined_Subprogram, Node_Id), + Sm (Original_Protected_Subprogram, Node_Id), + Sm (Postconditions_Proc, Node_Id), + Sm (Protected_Subprogram, Node_Id), + Sm (Protection_Object, Node_Id), + Sm (Related_Expression, Node_Id), + Sm (Renaming_Map, Uint), + Sm (Rewritten_For_C, Flag), + Sm (Thunk_Entity, Node_Id, + Pre => "Is_Thunk (N)"), + Sm (Wrapped_Entity, Node_Id, + Pre => "Is_Primitive_Wrapper (N)"))); + + Cc (E_Operator, Subprogram_Kind, + (Sm (Extra_Accessibility_Of_Result, Node_Id))); + + Cc (E_Procedure, Subprogram_Kind, + (Sm (Anonymous_Masters, Elist_Id), + Sm (Associated_Node_For_Itype, Node_Id), + Sm (Corresponding_Function, Node_Id), +-- ????See comment in E_Function. +-- Sm (DT_Position, Uint, +-- Pre => "Present (DTC_Entity (N))"), + Sm (DT_Position, Uint), + Sm (DTC_Entity, Node_Id), + Sm (Entry_Parameters_Type, Node_Id), + Sm (Generic_Renamings, Elist_Id), + Sm (Handler_Records, List_Id), + Sm (Inner_Instances, Elist_Id), + Sm (Is_Asynchronous, Flag), + Sm (Is_Called, Flag), + Sm (Is_CUDA_Kernel, Flag), + Sm (Is_DIC_Procedure, Flag), + Sm (Is_Generic_Actual_Subprogram, Flag), + Sm (Is_Initial_Condition_Procedure, Flag), + Sm (Is_Inlined_Always, Flag), + Sm (Is_Invariant_Procedure, Flag), + Sm (Is_Null_Init_Proc, Flag), + Sm (Is_Partial_Invariant_Procedure, Flag), + Sm (Is_Predicate_Function, Flag), + Sm (Is_Predicate_Function_M, Flag), + Sm (Is_Primitive_Wrapper, Flag), + Sm (Is_Private_Primitive, Flag), + Sm (Is_Valued_Procedure, Flag), + Sm (Next_Inlined_Subprogram, Node_Id), + Sm (Original_Protected_Subprogram, Node_Id), + Sm (Postconditions_Proc, Node_Id), + Sm (Protected_Subprogram, Node_Id), + Sm (Protection_Object, Node_Id), + Sm (Receiving_Entry, Node_Id), + Sm (Renaming_Map, Uint), + Sm (Static_Initialization, Node_Id, + Pre => "not Is_Dispatching_Operation (N)"), + Sm (Thunk_Entity, Node_Id, + Pre => "Is_Thunk (N)"), + Sm (Wrapped_Entity, Node_Id, + Pre => "Is_Primitive_Wrapper (N)"))); + + Cc (E_Abstract_State, Overloadable_Kind, + (Sm (Body_References, Elist_Id), + Sm (Encapsulating_State, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Has_Partial_Visible_Refinement, Flag), + Sm (Has_Visible_Refinement, Flag), + Sm (Non_Limited_View, Node_Id), + Sm (Part_Of_Constituents, Elist_Id), + Sm (Refinement_Constituents, Elist_Id), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag))); + + Cc (E_Entry, Overloadable_Kind, + (Sm (Accept_Address, Elist_Id), + Sm (Barrier_Function, Node_Id), + Sm (Contract, Node_Id), + Sm (Contract_Wrapper, Node_Id), + Sm (Elaboration_Entity, Node_Id), + Sm (Elaboration_Entity_Required, Flag), + Sm (Entry_Accepted, Flag), + Sm (Entry_Parameters_Type, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Has_Out_Or_In_Out_Parameter, Flag), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Last_Entity, Node_Id), + Sm (Postconditions_Proc, Node_Id), + Sm (Protected_Body_Subprogram, Node_Id), + Sm (Protection_Object, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag))); + + Cc (E_Entry_Family, Entity_Kind, + (Sm (Accept_Address, Elist_Id), + Sm (Barrier_Function, Node_Id), + Sm (Contract, Node_Id), + Sm (Contract_Wrapper, Node_Id), + Sm (Elaboration_Entity, Node_Id), + Sm (Elaboration_Entity_Required, Flag), + Sm (Entry_Accepted, Flag), + Sm (Entry_Parameters_Type, Node_Id), + Sm (Extra_Formals, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Has_Out_Or_In_Out_Parameter, Flag), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Last_Entity, Node_Id), + Sm (Needs_No_Actuals, Flag), + Sm (Postconditions_Proc, Node_Id), + Sm (Protected_Body_Subprogram, Node_Id), + Sm (Protection_Object, Node_Id), + Sm (Renamed_Or_Alias, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag))); + + Cc (E_Block, Entity_Kind, + (Sm (Block_Node, Node_Id), + Sm (Entry_Cancel_Parameter, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Is_Exception_Handler, Flag), + Sm (Last_Entity, Node_Id), + Sm (Renamed_Or_Alias, Node_Id), + Sm (Return_Applies_To, Node_Id), + Sm (Scope_Depth_Value, Uint))); + + Cc (E_Entry_Index_Parameter, Entity_Kind, + (Sm (Entry_Index_Constant, Node_Id))); + + Cc (E_Exception, Entity_Kind, + (Sm (Alignment, Uint), + Sm (Esize, Uint), + Sm (Interface_Name, Node_Id), + Sm (Is_Raised, Flag), + Sm (Register_Exception_Call, Node_Id), + Sm (Renamed_Or_Alias, Node_Id))); + + Ab (Generic_Unit_Kind, Entity_Kind, + (Sm (Body_Needed_For_SAL, Flag), + Sm (Contract, Node_Id), + Sm (Elaboration_Entity, Node_Id), + Sm (Elaboration_Entity_Required, Flag), + Sm (First_Entity, Node_Id), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (Inner_Instances, Elist_Id), + Sm (Interface_Name, Node_Id), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Last_Entity, Node_Id), + Sm (Renamed_Or_Alias, Node_Id), + Sm (Renaming_Map, Uint), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag))); + + Ab (Generic_Subprogram_Kind, Generic_Unit_Kind, + (Sm (Has_Out_Or_In_Out_Parameter, Flag), + Sm (Is_Primitive, Flag), + Sm (Next_Inlined_Subprogram, Node_Id), + Sm (Overridden_Operation, Node_Id))); + + Cc (E_Generic_Function, Generic_Subprogram_Kind, + (Sm (Has_Missing_Return, Flag))); + + Cc (E_Generic_Procedure, Generic_Subprogram_Kind); + + Cc (E_Generic_Package, Generic_Unit_Kind, + (Sm (Abstract_States, Elist_Id), + Sm (Body_Entity, Node_Id), + Sm (First_Private_Entity, Node_Id), + Sm (Generic_Homonym, Node_Id), + Sm (Package_Instantiation, Node_Id), + Sm (SPARK_Aux_Pragma, Node_Id), + Sm (SPARK_Aux_Pragma_Inherited, Flag))); + + Cc (E_Label, Entity_Kind, + (Sm (Enclosing_Scope, Node_Id), + Sm (Renamed_Or_Alias, Node_Id))); + + Cc (E_Loop, Entity_Kind, + (Sm (First_Entity, Node_Id), + Sm (First_Exit_Statement, Node_Id), + Sm (Has_Loop_Entry_Attributes, Flag), + Sm (Last_Entity, Node_Id), + Sm (Renamed_Or_Alias, Node_Id), + Sm (Scope_Depth_Value, Uint))); + + Cc (E_Return_Statement, Entity_Kind, + (Sm (First_Entity, Node_Id), + Sm (Last_Entity, Node_Id), + Sm (Return_Applies_To, Node_Id), + Sm (Scope_Depth_Value, Uint))); + + Cc (E_Package, Entity_Kind, + (Sm (Abstract_States, Elist_Id), + Sm (Anonymous_Masters, Elist_Id), + Sm (Associated_Formal_Package, Node_Id), + Sm (Body_Entity, Node_Id), + Sm (Body_Needed_For_Inlining, Flag), + Sm (Body_Needed_For_SAL, Flag), + Sm (Contract, Node_Id), + Sm (Current_Use_Clause, Node_Id), + Sm (Dependent_Instances, Elist_Id, + Pre => "Is_Generic_Instance (N)"), + Sm (Elaborate_Body_Desirable, Flag), + Sm (Elaboration_Entity, Node_Id), + Sm (Elaboration_Entity_Required, Flag), + Sm (Finalizer, Node_Id), + Sm (First_Entity, Node_Id), + Sm (First_Private_Entity, Node_Id), + Sm (Generic_Renamings, Elist_Id), + Sm (Handler_Records, List_Id), + Sm (Has_RACW, Flag), + Sm (Hidden_In_Formal_Instance, Elist_Id), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (Incomplete_Actuals, Elist_Id), + Sm (Inner_Instances, Elist_Id), + Sm (Interface_Name, Node_Id), + Sm (Is_Called, Flag), + Sm (Is_Elaboration_Checks_OK_Id, Flag), + Sm (Is_Elaboration_Warnings_OK_Id, Flag), + Sm (Last_Entity, Node_Id), + Sm (Limited_View, Node_Id), + Sm (Package_Instantiation, Node_Id), + Sm (Related_Instance, Node_Id), + Sm (Renamed_In_Spec, Flag), + Sm (Renamed_Or_Alias, Node_Id), + Sm (Renaming_Map, Uint), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Aux_Pragma, Node_Id), + Sm (SPARK_Aux_Pragma_Inherited, Flag), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag), + Sm (Static_Elaboration_Desired, Flag))); + + Cc (E_Package_Body, Entity_Kind, + (Sm (Contract, Node_Id), + Sm (Finalizer, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Handler_Records, List_Id), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (Last_Entity, Node_Id), + Sm (Related_Instance, Node_Id), + Sm (Renamed_Or_Alias, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Aux_Pragma, Node_Id), + Sm (SPARK_Aux_Pragma_Inherited, Flag), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag), + Sm (Spec_Entity, Node_Id))); + + Ab (Concurrent_Body_Kind, Entity_Kind, + (Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag))); + + Cc (E_Protected_Body, Concurrent_Body_Kind); + + Cc (E_Task_Body, Concurrent_Body_Kind, + (Sm (Contract, Node_Id), + Sm (First_Entity, Node_Id))); + + Cc (E_Subprogram_Body, Entity_Kind, + (Sm (Anonymous_Masters, Elist_Id), + Sm (Contract, Node_Id), + Sm (Corresponding_Protected_Entry, Node_Id), + Sm (Extra_Formals, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Ignore_SPARK_Mode_Pragmas, Flag), + Sm (Interface_Name, Node_Id), + Sm (Last_Entity, Node_Id), + Sm (Renamed_Or_Alias, Node_Id), + Sm (Scope_Depth_Value, Uint), + Sm (SPARK_Pragma, Node_Id), + Sm (SPARK_Pragma_Inherited, Flag))); + + -- Union types. These don't fit into the normal parent/child hierarchy + -- above. + + Union (Anonymous_Access_Kind, + Children => + (E_Anonymous_Access_Protected_Subprogram_Type, + E_Anonymous_Access_Subprogram_Type, + E_Anonymous_Access_Type)); + + Union (Assignable_Kind, + Children => + (E_Variable, + E_Out_Parameter, + E_In_Out_Parameter)); + + Union (Digits_Kind, + Children => + (Decimal_Fixed_Point_Kind, + Float_Kind)); + + Union (Discrete_Or_Fixed_Point_Kind, + Children => + (Discrete_Kind, + Fixed_Point_Kind)); + + Union (Entry_Kind, + Children => + (E_Entry, + E_Entry_Family)); + + Union (Numeric_Kind, + Children => + (Integer_Kind, + Fixed_Point_Kind, + Float_Kind)); + + Union (Record_Kind, + Children => + (E_Class_Wide_Type, + E_Class_Wide_Subtype, + E_Record_Type, + E_Record_Subtype, + E_Record_Type_With_Private, + E_Record_Subtype_With_Private)); + +end Gen_IL.Gen.Gen_Entities; diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb new file mode 100644 index 00000000000..24c63dd4f22 --- /dev/null +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -0,0 +1,1616 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . G E N . G E N _ N O D E 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. -- +-- -- +------------------------------------------------------------------------------ + +procedure Gen_IL.Gen.Gen_Nodes is + + procedure Ab -- Short for "Abstract" + (T : Abstract_Node; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + renames Create_Abstract_Node_Type; + procedure Cc -- Short for "ConCrete" + (T : Concrete_Node; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + renames Create_Concrete_Node_Type; + + function Sy -- Short for "Syntactic" + (Field : Node_Field; Field_Type : Type_Enum; + Default_Value : Field_Default_Value := No_Default; + Pre : String := "") return Field_Desc + renames Create_Syntactic_Field; + function Sm -- Short for "Semantic" + (Field : Field_Enum; Field_Type : Type_Enum; + Type_Only : Type_Only_Enum := No_Type_Only; + Pre : String := "") return Field_Desc + renames Create_Semantic_Field; + + procedure Union (T : Abstract_Node; Children : Type_Array) + renames Create_Node_Union; + +begin -- Gen_IL.Gen.Gen_Nodes + pragma Style_Checks ("M200"); + + -- N_Empty should not inherit all of these fields???? + -- But the following getters and setters are called on Empty: + -- + -- Set_Comes_From_Source + -- Set_Sloc + -- + -- Comes_From_Source + -- Error_Posted + -- In_List + -- Link + -- Rewrite_Ins + -- Sloc + -- Small_Paren_Count + Create_Root_Node_Type (Node_Kind, + (Sm (Nkind, Nkind_Type), + Sm (Sloc, Source_Ptr), + Sm (In_List, Flag), + Sm (Rewrite_Ins, Flag), + Sm (Comes_From_Source, Flag), + Sm (Analyzed, Flag), + Sm (Error_Posted, Flag), + Sm (Small_Paren_Count, Small_Paren_Count_Type), + Sm (Check_Actuals, Flag), + Sm (Has_Aspects, Flag), + Sm (Is_Ignored_Ghost_Node, Flag), + Sm (Link, Union_Id))); + + Cc (N_Unused_At_Start, Node_Kind); + + Ab (N_Representation_Clause, Node_Kind); + + Cc (N_At_Clause, N_Representation_Clause, + (Sy (Identifier, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_Component_Clause, N_Representation_Clause, + (Sy (Component_Name, Node_Id), + Sy (Position, Node_Id), + Sy (First_Bit, Node_Id), + Sy (Last_Bit, Node_Id))); + + Cc (N_Enumeration_Representation_Clause, N_Representation_Clause, + (Sy (Identifier, Node_Id, Default_Empty), + Sy (Array_Aggregate, Node_Id), + Sm (Next_Rep_Item, Node_Id))); + + Cc (N_Mod_Clause, N_Representation_Clause, + (Sy (Expression, Node_Id, Default_Empty), + Sy (Pragmas_Before, List_Id, Default_No_List))); + + Cc (N_Record_Representation_Clause, N_Representation_Clause, + (Sy (Identifier, Node_Id, Default_Empty), + Sy (Mod_Clause, Node_Id, Default_Empty), + Sy (Component_Clauses, List_Id), + Sm (Next_Rep_Item, Node_Id))); + + Cc (N_Attribute_Definition_Clause, N_Representation_Clause, + (Sy (Name, Node_Id, Default_Empty), + Sy (Chars, Name_Id, Default_No_Name), + Sy (Expression, Node_Id, Default_Empty), + Sm (Address_Warning_Posted, Flag), + Sm (Check_Address_Alignment, Flag), + Sm (Entity_Or_Associated_Node, Node_Id), -- just Entity + Sm (From_Aspect_Specification, Flag), + Sm (From_At_Mod, Flag), + Sm (Is_Delayed_Aspect, Flag), + Sm (Next_Rep_Item, Node_Id))); + + Cc (N_Empty, Node_Kind, + (Sy (Chars, Name_Id, Default_No_Name))); + + Cc (N_Pragma_Argument_Association, Node_Kind, + (Sy (Chars, Name_Id, Default_No_Name), + Sy (Expression, Node_Id, Default_Empty), + Sm (Expression_Copy, Node_Id))); + + Ab (N_Has_Etype, Node_Kind, + (Sm (Etype, Node_Id))); + + Cc (N_Error, N_Has_Etype, + (Sy (Chars, Name_Id, Default_No_Name))); + + Ab (N_Entity, N_Has_Etype, + (Sm (Next_Entity, Node_Id), + Sm (Scope, Node_Id))); + + Cc (N_Defining_Character_Literal, N_Entity, + (Sy (Chars, Name_Id, Default_No_Name))); + + Cc (N_Defining_Identifier, N_Entity, + (Sy (Chars, Name_Id, Default_No_Name))); + + Cc (N_Defining_Operator_Symbol, N_Entity, + (Sy (Chars, Name_Id, Default_No_Name))); + + Ab (N_Subexpr, N_Has_Etype, + (Sm (Assignment_OK, Flag), + Sm (Do_Range_Check, Flag), + Sm (Has_Dynamic_Length_Check, Flag), + Sm (Is_Controlling_Actual, Flag), + Sm (Is_Overloaded, Flag), + Sm (Is_Static_Expression, Flag), + Sm (Must_Not_Freeze, Flag), + Sm (Raises_Constraint_Error, Flag))); + + Ab (N_Has_Entity, N_Subexpr, + (Sm (Entity_Or_Associated_Node, Node_Id))); -- both + + Cc (N_Expanded_Name, N_Has_Entity, + (Sy (Chars, Name_Id, Default_No_Name), + Sy (Prefix, Node_Id), + Sy (Selector_Name, Node_Id, Default_Empty), + Sm (Atomic_Sync_Required, Flag), + Sm (Has_Private_View, Flag), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (Redundant_Use, Flag))); + + Ab (N_Direct_Name, N_Has_Entity, + (Sm (Has_Private_View, Flag))); + + Cc (N_Identifier, N_Direct_Name, + (Sy (Chars, Name_Id, Default_No_Name), + Sm (Atomic_Sync_Required, Flag), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (Original_Discriminant, Node_Id), + Sm (Redundant_Use, Flag))); + + Cc (N_Operator_Symbol, N_Direct_Name, + (Sy (Chars, Name_Id, Default_No_Name), + Sy (Strval, String_Id))); + + Cc (N_Character_Literal, N_Direct_Name, + (Sy (Chars, Name_Id, Default_No_Name), + Sy (Char_Literal_Value, Uint))); + + Ab (N_Op, N_Has_Entity, + (Sm (Do_Overflow_Check, Flag), + Sm (Has_Private_View, Flag))); + + Ab (N_Binary_Op, N_Op); + + Cc (N_Op_Add, N_Binary_Op, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Concat, N_Binary_Op, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Is_Component_Left_Opnd, Flag), + Sm (Is_Component_Right_Opnd, Flag))); + + Cc (N_Op_Expon, N_Binary_Op, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Is_Power_Of_2_For_Shift, Flag))); + + Cc (N_Op_Subtract, N_Binary_Op, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Ab (N_Multiplying_Operator, N_Binary_Op); + + Cc (N_Op_Divide, N_Multiplying_Operator, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Do_Division_Check, Flag), + Sm (Rounded_Result, Flag))); + + Cc (N_Op_Mod, N_Multiplying_Operator, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Do_Division_Check, Flag))); + + Cc (N_Op_Multiply, N_Multiplying_Operator, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Rounded_Result, Flag))); + + Cc (N_Op_Rem, N_Multiplying_Operator, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Do_Division_Check, Flag))); + + Ab (N_Op_Boolean, N_Binary_Op); + + Cc (N_Op_And, N_Op_Boolean, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Do_Length_Check, Flag))); + + Ab (N_Op_Compare, N_Op_Boolean); + + Cc (N_Op_Eq, N_Op_Compare, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Ge, N_Op_Compare, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Gt, N_Op_Compare, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Le, N_Op_Compare, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Lt, N_Op_Compare, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Ne, N_Op_Compare, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Or, N_Op_Boolean, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Do_Length_Check, Flag))); + + Cc (N_Op_Xor, N_Op_Boolean, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Do_Length_Check, Flag))); + + Ab (N_Op_Shift, N_Binary_Op, + (Sm (Shift_Count_OK, Flag))); + + Cc (N_Op_Rotate_Left, N_Op_Shift, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Rotate_Right, N_Op_Shift, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Shift_Left, N_Op_Shift, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Shift_Right, N_Op_Shift, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Shift_Right_Arithmetic, N_Op_Shift, + (Sm (Chars, Name_Id), + Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id))); + + Ab (N_Unary_Op, N_Op); + + Cc (N_Op_Abs, N_Unary_Op, + (Sm (Chars, Name_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Minus, N_Unary_Op, + (Sm (Chars, Name_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Not, N_Unary_Op, + (Sm (Chars, Name_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Op_Plus, N_Unary_Op, + (Sm (Chars, Name_Id), + Sy (Right_Opnd, Node_Id))); + + Cc (N_Attribute_Reference, N_Has_Entity, + (Sy (Prefix, Node_Id), + Sy (Attribute_Name, Name_Id), + Sy (Expressions, List_Id, Default_No_List), + Sm (Do_Overflow_Check, Flag), + Sm (Header_Size_Added, Flag), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (Must_Be_Byte_Aligned, Flag), + Sm (Redundant_Use, Flag))); + + Ab (N_Membership_Test, N_Subexpr); + + Cc (N_In, N_Membership_Test, + (Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sy (Alternatives, List_Id, Default_No_List), + Sy (No_Minimize_Eliminate, Flag))); + + Cc (N_Not_In, N_Membership_Test, + (Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sy (Alternatives, List_Id, Default_No_List), + Sy (No_Minimize_Eliminate, Flag))); + + Ab (N_Short_Circuit, N_Subexpr); + + Cc (N_And_Then, N_Short_Circuit, + (Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Actions, List_Id))); + + Cc (N_Or_Else, N_Short_Circuit, + (Sy (Left_Opnd, Node_Id), + Sy (Right_Opnd, Node_Id), + Sm (Actions, List_Id))); + + Ab (N_Subprogram_Call, N_Subexpr, + (Sm (Controlling_Argument, Node_Id), + Sm (Do_Tag_Check, Flag), + Sm (First_Named_Actual, Node_Id), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_Known_Guaranteed_ABE, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (No_Elaboration_Check, Flag))); + + Cc (N_Function_Call, N_Subprogram_Call, + (Sy (Name, Node_Id, Default_Empty), + Sy (Parameter_Associations, List_Id, Default_No_List), + Sm (Is_Expanded_Build_In_Place_Call, Flag), + Sm (No_Side_Effect_Removal, Flag))); + + Cc (N_Procedure_Call_Statement, N_Subprogram_Call, + (Sy (Name, Node_Id, Default_Empty), + Sy (Parameter_Associations, List_Id, Default_No_List))); + + Ab (N_Raise_xxx_Error, N_Subexpr); + + Cc (N_Raise_Constraint_Error, N_Raise_xxx_Error, + (Sy (Condition, Node_Id, Default_Empty), + Sy (Reason, Uint))); + + Cc (N_Raise_Program_Error, N_Raise_xxx_Error, + (Sy (Condition, Node_Id, Default_Empty), + Sy (Reason, Uint))); + + Cc (N_Raise_Storage_Error, N_Raise_xxx_Error, + (Sy (Condition, Node_Id, Default_Empty), + Sy (Reason, Uint))); + + Ab (N_Numeric_Or_String_Literal, N_Subexpr); + + Cc (N_Integer_Literal, N_Numeric_Or_String_Literal, + (Sy (Intval, Uint), + Sm (Original_Entity, Node_Id), + Sm (Print_In_Hex, Flag))); + + Cc (N_Real_Literal, N_Numeric_Or_String_Literal, + (Sy (Realval, Ureal), + Sm (Corresponding_Integer_Value, Uint), + Sm (Is_Machine_Number, Flag), + Sm (Original_Entity, Node_Id))); + + Cc (N_String_Literal, N_Numeric_Or_String_Literal, + (Sy (Strval, String_Id), + Sy (Is_Folded_In_Parser, Flag), + Sm (Has_Wide_Character, Flag), + Sm (Has_Wide_Wide_Character, Flag))); + + Cc (N_Explicit_Dereference, N_Subexpr, + (Sy (Prefix, Node_Id), + Sm (Actual_Designated_Subtype, Node_Id), + Sm (Atomic_Sync_Required, Flag), + Sm (Has_Dereference_Action, Flag))); + + Cc (N_Expression_With_Actions, N_Subexpr, + (Sy (Actions, List_Id, Default_No_List), + Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_If_Expression, N_Subexpr, + (Sy (Expressions, List_Id, Default_No_List), + Sy (Is_Elsif, Flag), + Sm (Do_Overflow_Check, Flag), + Sm (Else_Actions, List_Id), + Sm (Then_Actions, List_Id))); + + Cc (N_Indexed_Component, N_Subexpr, + (Sy (Prefix, Node_Id), + Sy (Expressions, List_Id, Default_No_List), + Sm (Atomic_Sync_Required, Flag), + Sm (Generalized_Indexing, Node_Id))); + + Cc (N_Null, N_Subexpr); + + Cc (N_Qualified_Expression, N_Subexpr, + (Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sm (Is_Qualified_Universal_Literal, Flag))); + + Cc (N_Quantified_Expression, N_Subexpr, + (Sy (Iterator_Specification, Node_Id, Default_Empty), + Sy (Loop_Parameter_Specification, Node_Id, Default_Empty), + Sy (Condition, Node_Id, Default_Empty), + Sy (All_Present, Flag))); + + Cc (N_Aggregate, N_Subexpr, + (Sy (Expressions, List_Id, Default_No_List), + Sy (Component_Associations, List_Id, Default_No_List), + Sy (Null_Record_Present, Flag), + Sy (Is_Homogeneous_Aggregate, Flag), + Sm (Aggregate_Bounds, Node_Id), + Sm (Entity_Or_Associated_Node, Node_Id), -- just Associated_Node + Sm (Compile_Time_Known_Aggregate, Flag), + Sm (Expansion_Delayed, Flag), + Sm (Has_Self_Reference, Flag))); + + Cc (N_Allocator, N_Subexpr, + (Sy (Expression, Node_Id, Default_Empty), + Sy (Subpool_Handle_Name, Node_Id, Default_Empty), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sm (Alloc_For_BIP_Return, Flag), + Sm (Do_Storage_Check, Flag), + Sm (Is_Dynamic_Coextension, Flag), + Sm (Is_Static_Coextension, Flag), + Sm (No_Initialization, Flag), + Sm (Procedure_To_Call, Node_Id), + Sm (Storage_Pool, Node_Id))); + + Cc (N_Case_Expression, N_Subexpr, + (Sy (Expression, Node_Id, Default_Empty), + Sy (Alternatives, List_Id, Default_No_List), + Sm (Do_Overflow_Check, Flag))); + + Cc (N_Delta_Aggregate, N_Subexpr, + (Sy (Expression, Node_Id, Default_Empty), + Sy (Component_Associations, List_Id, Default_No_List))); + + Cc (N_Extension_Aggregate, N_Subexpr, + (Sy (Ancestor_Part, Node_Id), + Sy (Expressions, List_Id, Default_No_List), + Sy (Component_Associations, List_Id, Default_No_List), + Sy (Null_Record_Present, Flag), + Sm (Entity_Or_Associated_Node, Node_Id), -- just Associated_Node + Sm (Expansion_Delayed, Flag), + Sm (Has_Self_Reference, Flag))); + + Cc (N_Raise_Expression, N_Subexpr, + (Sy (Name, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sm (Convert_To_Return_False, Flag))); + + Cc (N_Range, N_Subexpr, + (Sy (Low_Bound, Node_Id), + Sy (High_Bound, Node_Id), + Sy (Includes_Infinities, Flag))); + + Cc (N_Reference, N_Subexpr, + (Sy (Prefix, Node_Id))); + + Cc (N_Selected_Component, N_Subexpr, + (Sy (Prefix, Node_Id), + Sy (Selector_Name, Node_Id, Default_Empty), + Sm (Atomic_Sync_Required, Flag), + Sm (Entity_Or_Associated_Node, Node_Id), -- just Associated_Node + Sm (Do_Discriminant_Check, Flag), + Sm (Is_In_Discriminant_Check, Flag), + Sm (Is_Prefixed_Call, Flag))); + + Cc (N_Slice, N_Subexpr, + (Sy (Prefix, Node_Id), + Sy (Discrete_Range, Node_Id))); + + Cc (N_Target_Name, N_Subexpr); + + Cc (N_Type_Conversion, N_Subexpr, + (Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sm (Conversion_OK, Flag), + Sm (Do_Discriminant_Check, Flag), + Sm (Do_Length_Check, Flag), + Sm (Do_Overflow_Check, Flag), + Sm (Do_Tag_Check, Flag), + Sm (Float_Truncate, Flag), + Sm (Rounded_Result, Flag))); + + Cc (N_Unchecked_Expression, N_Subexpr, + (Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_Unchecked_Type_Conversion, N_Subexpr, + (Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sm (Kill_Range_Check, Flag), + Sm (No_Truncation, Flag))); + + Cc (N_Subtype_Indication, N_Has_Etype, + (Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Constraint, Node_Id), + Sm (Must_Not_Freeze, Flag))); + + Ab (N_Declaration, Node_Kind); + + Cc (N_Component_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Component_Definition, Node_Id), + Sy (Expression, Node_Id, Default_Empty), + Sm (More_Ids, Flag), + Sm (Prev_Ids, Flag))); + + Cc (N_Entry_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Discrete_Subtype_Definition, Node_Id, Default_Empty), + Sy (Parameter_Specifications, List_Id, Default_No_List), + Sy (Must_Override, Flag), + Sy (Must_Not_Override, Flag), + Sm (Corresponding_Body, Node_Id))); + + Cc (N_Expression_Function, N_Declaration, + (Sy (Specification, Node_Id), + Sy (Expression, Node_Id, Default_Empty), + Sm (Corresponding_Spec, Node_Id))); + + Cc (N_Formal_Object_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (In_Present, Flag), + Sy (Out_Present, Flag), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Access_Definition, Node_Id, Default_Empty), + Sy (Default_Expression, Node_Id, Default_Empty), + Sm (More_Ids, Flag), + Sm (Prev_Ids, Flag))); + + Cc (N_Formal_Type_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Formal_Type_Definition, Node_Id), + Sy (Discriminant_Specifications, List_Id, Default_No_List), + Sy (Unknown_Discriminants_Present, Flag))); + + Cc (N_Full_Type_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Discriminant_Specifications, List_Id, Default_No_List), + Sy (Type_Definition, Node_Id), + Sm (Discr_Check_Funcs_Built, Flag), + Sm (Incomplete_View, Node_Id))); + + Cc (N_Incomplete_Type_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Discriminant_Specifications, List_Id, Default_No_List), + Sy (Unknown_Discriminants_Present, Flag), + Sy (Tagged_Present, Flag), + Sm (Premature_Use, Node_Id))); + + Cc (N_Iterator_Specification, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Name, Node_Id, Default_Empty), + Sy (Reverse_Present, Flag), + Sy (Of_Present, Flag), + Sy (Iterator_Filter, Node_Id, Default_Empty), + Sy (Subtype_Indication, Node_Id, Default_Empty))); + + Cc (N_Loop_Parameter_Specification, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Reverse_Present, Flag), + Sy (Iterator_Filter, Node_Id, Default_Empty), + Sy (Discrete_Subtype_Definition, Node_Id, Default_Empty))); + + Cc (N_Object_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Aliased_Present, Flag), + Sy (Constant_Present, Flag), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Object_Definition, Node_Id), + Sy (Expression, Node_Id, Default_Empty), + Sy (Has_Init_Expression, Flag), + Sm (Assignment_OK, Flag), + Sm (Corresponding_Generic_Association, Node_Id), + Sm (Exception_Junk, Flag), + Sm (Handler_List_Entry, Node_Id), + Sm (Is_Subprogram_Descriptor, Flag), + Sm (More_Ids, Flag), + Sm (No_Initialization, Flag), + Sm (Prev_Ids, Flag), + Sm (Suppress_Assignment_Checks, Flag))); + + Cc (N_Protected_Type_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Discriminant_Specifications, List_Id, Default_No_List), + Sy (Interface_List, List_Id, Default_No_List), + Sy (Protected_Definition, Node_Id), + Sm (Corresponding_Body, Node_Id))); + + Cc (N_Private_Extension_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Discriminant_Specifications, List_Id, Default_No_List), + Sy (Unknown_Discriminants_Present, Flag), + Sy (Abstract_Present, Flag), + Sy (Limited_Present, Flag), + Sy (Synchronized_Present, Flag), + Sy (Subtype_Indication, Node_Id, Default_Empty), + Sy (Interface_List, List_Id, Default_No_List), + Sm (Uninitialized_Variable, Node_Id))); + + Cc (N_Private_Type_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Discriminant_Specifications, List_Id, Default_No_List), + Sy (Unknown_Discriminants_Present, Flag), + Sy (Abstract_Present, Flag), + Sy (Tagged_Present, Flag), + Sy (Limited_Present, Flag))); + + Cc (N_Subtype_Declaration, N_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Subtype_Indication, Node_Id, Default_Empty), + Sm (Exception_Junk, Flag), + Sm (Generic_Parent_Type, Node_Id))); + + Ab (N_Subprogram_Specification, N_Declaration, + (Sm (Generic_Parent, Node_Id))); + + Cc (N_Function_Specification, N_Subprogram_Specification, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Parameter_Specifications, List_Id, Default_No_List), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Result_Definition, Node_Id), + Sy (Must_Override, Flag), + Sy (Must_Not_Override, Flag))); + + Cc (N_Procedure_Specification, N_Subprogram_Specification, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Parameter_Specifications, List_Id, Default_No_List), + Sy (Null_Present, Flag), + Sy (Must_Override, Flag), + Sy (Must_Not_Override, Flag), + Sm (Null_Statement, Node_Id))); + + Ab (N_Access_To_Subprogram_Definition, Node_Kind); + + Cc (N_Access_Function_Definition, N_Access_To_Subprogram_Definition, + (Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Null_Exclusion_In_Return_Present, Flag), + Sy (Protected_Present, Flag), + Sy (Parameter_Specifications, List_Id, Default_No_List), + Sy (Result_Definition, Node_Id))); + + Cc (N_Access_Procedure_Definition, N_Access_To_Subprogram_Definition, + (Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Protected_Present, Flag), + Sy (Parameter_Specifications, List_Id, Default_No_List))); + + Ab (N_Later_Decl_Item, Node_Kind); + + Cc (N_Task_Type_Declaration, N_Later_Decl_Item, + (Sy (Defining_Identifier, Node_Id), + Sy (Discriminant_Specifications, List_Id, Default_No_List), + Sy (Interface_List, List_Id, Default_No_List), + Sy (Task_Definition, Node_Id, Default_Empty), + Sm (Corresponding_Body, Node_Id))); + + Ab (N_Body_Stub, N_Later_Decl_Item, + (Sm (Corresponding_Body, Node_Id), + Sm (Corresponding_Spec_Of_Stub, Node_Id), + Sm (Library_Unit, Node_Id))); + + Cc (N_Package_Body_Stub, N_Body_Stub, + (Sy (Defining_Identifier, Node_Id))); + + Cc (N_Protected_Body_Stub, N_Body_Stub, + (Sy (Defining_Identifier, Node_Id))); + + Cc (N_Subprogram_Body_Stub, N_Body_Stub, + (Sy (Specification, Node_Id))); + + Cc (N_Task_Body_Stub, N_Body_Stub, + (Sy (Defining_Identifier, Node_Id))); + + Ab (N_Generic_Instantiation, N_Later_Decl_Item, + (Sm (Instance_Spec, Node_Id), + Sm (Is_Declaration_Level_Node, Flag), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_Known_Guaranteed_ABE, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (Parent_Spec, Node_Id))); + + Ab (N_Subprogram_Instantiation, N_Generic_Instantiation); + + Cc (N_Function_Instantiation, N_Subprogram_Instantiation, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Name, Node_Id, Default_Empty), + Sy (Generic_Associations, List_Id, Default_No_List), + Sy (Must_Override, Flag), + Sy (Must_Not_Override, Flag))); + + Cc (N_Procedure_Instantiation, N_Subprogram_Instantiation, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Name, Node_Id, Default_Empty), + Sy (Generic_Associations, List_Id, Default_No_List), + Sy (Must_Override, Flag), + Sy (Must_Not_Override, Flag))); + + Cc (N_Package_Instantiation, N_Generic_Instantiation, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Name, Node_Id, Default_Empty), + Sy (Generic_Associations, List_Id, Default_No_List))); + + Ab (N_Proper_Body, N_Later_Decl_Item, + (Sm (Corresponding_Spec, Node_Id), + Sm (Was_Originally_Stub, Flag))); + + Ab (N_Unit_Body, N_Proper_Body); + + Cc (N_Package_Body, N_Unit_Body, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Declarations, List_Id, Default_No_List), + Sy (Handled_Statement_Sequence, Node_Id, Default_Empty))); + + Cc (N_Subprogram_Body, N_Unit_Body, + (Sy (Specification, Node_Id), + Sy (Declarations, List_Id, Default_No_List), + Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), + Sy (Bad_Is_Detected, Flag), + Sm (Activation_Chain_Entity, Node_Id), + Sm (Acts_As_Spec, Flag), + Sm (Do_Storage_Check, Flag), + Sm (Has_Relative_Deadline_Pragma, Flag), + Sm (Is_Entry_Barrier_Function, Flag), + Sm (Is_Protected_Subprogram_Body, Flag), + Sm (Is_Task_Body_Procedure, Flag), + Sm (Is_Task_Master, Flag), + Sm (Was_Attribute_Reference, Flag), + Sm (Was_Expression_Function, Flag))); + + Cc (N_Protected_Body, N_Proper_Body, + (Sy (Defining_Identifier, Node_Id), + Sy (Declarations, List_Id, Default_No_List), + Sy (End_Label, Node_Id, Default_Empty))); + + Cc (N_Task_Body, N_Proper_Body, + (Sy (Defining_Identifier, Node_Id), + Sy (Declarations, List_Id, Default_No_List), + Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), + Sm (Activation_Chain_Entity, Node_Id), + Sm (Is_Task_Master, Flag))); + + Cc (N_Implicit_Label_Declaration, N_Later_Decl_Item, + (Sy (Defining_Identifier, Node_Id), + Sm (Label_Construct, Node_Id))); + + Cc (N_Package_Declaration, N_Later_Decl_Item, + (Sy (Specification, Node_Id), + Sm (Activation_Chain_Entity, Node_Id), + Sm (Corresponding_Body, Node_Id), + Sm (Parent_Spec, Node_Id))); + + Cc (N_Single_Task_Declaration, N_Later_Decl_Item, + (Sy (Defining_Identifier, Node_Id), + Sy (Interface_List, List_Id, Default_No_List), + Sy (Task_Definition, Node_Id, Default_Empty))); + + Cc (N_Subprogram_Declaration, N_Later_Decl_Item, + (Sy (Specification, Node_Id), + Sm (Body_To_Inline, Node_Id), + Sm (Corresponding_Body, Node_Id), + Sm (Is_Entry_Barrier_Function, Flag), + Sm (Is_Task_Body_Procedure, Flag), + Sm (Parent_Spec, Node_Id))); + + Cc (N_Use_Package_Clause, N_Later_Decl_Item, + (Sy (Name, Node_Id, Default_Empty), + Sy (Is_Effective_Use_Clause, Flag), + Sm (Entity_Or_Associated_Node, Node_Id), -- just Associated_Node + Sm (Hidden_By_Use_Clause, Elist_Id), + Sm (More_Ids, Flag), + Sm (Next_Use_Clause, Node_Id), + Sm (Prev_Ids, Flag), + Sm (Prev_Use_Clause, Node_Id))); + + Ab (N_Generic_Declaration, N_Later_Decl_Item, + (Sm (Corresponding_Body, Node_Id), + Sm (Parent_Spec, Node_Id))); + + Cc (N_Generic_Package_Declaration, N_Generic_Declaration, + (Sy (Specification, Node_Id), + Sy (Generic_Formal_Declarations, List_Id), + Sm (Activation_Chain_Entity, Node_Id))); + + Cc (N_Generic_Subprogram_Declaration, N_Generic_Declaration, + (Sy (Specification, Node_Id), + Sy (Generic_Formal_Declarations, List_Id))); + + Ab (N_Array_Type_Definition, Node_Kind); + + Cc (N_Constrained_Array_Definition, N_Array_Type_Definition, + (Sy (Discrete_Subtype_Definitions, List_Id), + Sy (Component_Definition, Node_Id))); + + Cc (N_Unconstrained_Array_Definition, N_Array_Type_Definition, + (Sy (Subtype_Marks, List_Id), + Sy (Component_Definition, Node_Id))); + + Ab (N_Renaming_Declaration, Node_Kind); + + Cc (N_Exception_Renaming_Declaration, N_Renaming_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Name, Node_Id, Default_Empty))); + + Cc (N_Object_Renaming_Declaration, N_Renaming_Declaration, + (Sy (Defining_Identifier, Node_Id), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Access_Definition, Node_Id, Default_Empty), + Sy (Name, Node_Id, Default_Empty), + Sm (Corresponding_Generic_Association, Node_Id))); + + Cc (N_Package_Renaming_Declaration, N_Renaming_Declaration, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Name, Node_Id, Default_Empty), + Sm (Parent_Spec, Node_Id))); + + Cc (N_Subprogram_Renaming_Declaration, N_Renaming_Declaration, + (Sy (Specification, Node_Id), + Sy (Name, Node_Id, Default_Empty), + Sm (Corresponding_Formal_Spec, Node_Id), + Sm (Corresponding_Spec, Node_Id), + Sm (From_Default, Flag), + Sm (Parent_Spec, Node_Id))); + + Ab (N_Generic_Renaming_Declaration, N_Renaming_Declaration, + (Sm (Parent_Spec, Node_Id))); + + Cc (N_Generic_Function_Renaming_Declaration, N_Generic_Renaming_Declaration, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Name, Node_Id, Default_Empty))); + + Cc (N_Generic_Package_Renaming_Declaration, N_Generic_Renaming_Declaration, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Name, Node_Id, Default_Empty))); + + Cc (N_Generic_Procedure_Renaming_Declaration, N_Generic_Renaming_Declaration, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Name, Node_Id, Default_Empty))); + + Ab (N_Statement_Other_Than_Procedure_Call, Node_Kind); + + Cc (N_Abort_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Names, List_Id))); + + Cc (N_Accept_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Entry_Direct_Name, Node_Id), + Sy (Entry_Index, Node_Id, Default_Empty), + Sy (Parameter_Specifications, List_Id, Default_No_List), + Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), + Sy (Declarations, List_Id, Default_No_List))); + + Cc (N_Assignment_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Name, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sm (Backwards_OK, Flag), + Sm (Componentwise_Assignment, Flag), + Sm (Do_Discriminant_Check, Flag), + Sm (Do_Length_Check, Flag), + Sm (Do_Tag_Check, Flag), + Sm (Forwards_OK, Flag), + Sm (Has_Target_Names, Flag), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Code, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (No_Ctrl_Actions, Flag), + Sm (Suppress_Assignment_Checks, Flag))); + + Cc (N_Asynchronous_Select, N_Statement_Other_Than_Procedure_Call, + (Sy (Triggering_Alternative, Node_Id), + Sy (Abortable_Part, Node_Id))); + + Cc (N_Block_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Identifier, Node_Id, Default_Empty), + Sy (Declarations, List_Id, Default_No_List), + Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), + Sy (Has_Created_Identifier, Flag), + Sy (Is_Asynchronous_Call_Block, Flag), + Sy (Is_Task_Allocation_Block, Flag), + Sm (Activation_Chain_Entity, Node_Id), + Sm (Cleanup_Actions, List_Id), + Sm (Exception_Junk, Flag), + Sm (Is_Abort_Block, Flag), + Sm (Is_Finalization_Wrapper, Flag), + Sm (Is_Initialization_Block, Flag), + Sm (Is_Task_Master, Flag))); + + Cc (N_Case_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Expression, Node_Id, Default_Empty), + Sy (Alternatives, List_Id, Default_No_List), + Sy (End_Span, Uint, Default_Uint_0), + Sm (From_Conditional_Expression, Flag))); + + Cc (N_Code_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_Compound_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Actions, List_Id, Default_No_List))); + + Cc (N_Conditional_Entry_Call, N_Statement_Other_Than_Procedure_Call, + (Sy (Entry_Call_Alternative, Node_Id), + Sy (Else_Statements, List_Id, Default_No_List))); + + Ab (N_Delay_Statement, N_Statement_Other_Than_Procedure_Call); + + Cc (N_Delay_Relative_Statement, N_Delay_Statement, + (Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_Delay_Until_Statement, N_Delay_Statement, + (Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_Entry_Call_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Name, Node_Id, Default_Empty), + Sy (Parameter_Associations, List_Id, Default_No_List), + Sm (First_Named_Actual, Node_Id), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag))); + + Cc (N_Free_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Expression, Node_Id, Default_Empty), + Sm (Actual_Designated_Subtype, Node_Id), + Sm (Procedure_To_Call, Node_Id), + Sm (Storage_Pool, Node_Id))); + + Cc (N_Goto_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Name, Node_Id, Default_Empty), + Sm (Exception_Junk, Flag))); + + Cc (N_Loop_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Identifier, Node_Id, Default_Empty), + Sy (Iteration_Scheme, Node_Id, Default_Empty), + Sy (Statements, List_Id, Default_Empty_List), + Sy (End_Label, Node_Id, Default_Empty), + Sy (Has_Created_Identifier, Flag), + Sy (Is_Null_Loop, Flag), + Sy (Suppress_Loop_Warnings, Flag))); + + Cc (N_Null_Statement, N_Statement_Other_Than_Procedure_Call, + (Sm (Next_Rep_Item, Node_Id))); + + Cc (N_Raise_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Name, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sm (From_At_End, Flag))); + + Cc (N_Requeue_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Name, Node_Id, Default_Empty), + Sy (Abort_Present, Flag), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag))); + + Cc (N_Simple_Return_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Expression, Node_Id, Default_Empty), + Sm (By_Ref, Flag), + Sm (Comes_From_Extended_Return_Statement, Flag), + Sm (Do_Tag_Check, Flag), + Sm (Procedure_To_Call, Node_Id), + Sm (Return_Statement_Entity, Node_Id), + Sm (Storage_Pool, Node_Id))); + + Cc (N_Extended_Return_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Return_Object_Declarations, List_Id), + Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), + Sm (By_Ref, Flag), + Sm (Do_Tag_Check, Flag), + Sm (Procedure_To_Call, Node_Id), + Sm (Return_Statement_Entity, Node_Id), + Sm (Storage_Pool, Node_Id))); + + Cc (N_Selective_Accept, N_Statement_Other_Than_Procedure_Call, + (Sy (Select_Alternatives, List_Id), + Sy (Else_Statements, List_Id, Default_No_List))); + + Cc (N_Timed_Entry_Call, N_Statement_Other_Than_Procedure_Call, + (Sy (Entry_Call_Alternative, Node_Id), + Sy (Delay_Alternative, Node_Id))); + + Cc (N_Exit_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Name, Node_Id, Default_Empty), + Sy (Condition, Node_Id, Default_Empty), + Sm (Next_Exit_Statement, Node_Id))); + + Cc (N_If_Statement, N_Statement_Other_Than_Procedure_Call, + (Sy (Condition, Node_Id, Default_Empty), + Sy (Then_Statements, List_Id), + Sy (Elsif_Parts, List_Id, Default_No_List), + Sy (Else_Statements, List_Id, Default_No_List), + Sy (End_Span, Uint, Default_Uint_0), + Sm (From_Conditional_Expression, Flag))); + + Cc (N_Accept_Alternative, Node_Kind, + (Sy (Accept_Statement, Node_Id), + Sy (Condition, Node_Id, Default_Empty), + Sy (Statements, List_Id, Default_Empty_List), + Sy (Pragmas_Before, List_Id, Default_No_List), + Sm (Accept_Handler_Records, List_Id))); + + Cc (N_Delay_Alternative, Node_Kind, + (Sy (Delay_Statement, Node_Id), + Sy (Condition, Node_Id, Default_Empty), + Sy (Statements, List_Id, Default_Empty_List), + Sy (Pragmas_Before, List_Id, Default_No_List))); + + Cc (N_Elsif_Part, Node_Kind, + (Sy (Condition, Node_Id, Default_Empty), + Sy (Then_Statements, List_Id), + Sm (Condition_Actions, List_Id))); + + Cc (N_Entry_Body_Formal_Part, Node_Kind, + (Sy (Entry_Index_Specification, Node_Id, Default_Empty), + Sy (Parameter_Specifications, List_Id, Default_No_List), + Sy (Condition, Node_Id, Default_Empty))); + + Cc (N_Iteration_Scheme, Node_Kind, + (Sy (Condition, Node_Id, Default_Empty), + Sy (Iterator_Specification, Node_Id, Default_Empty), + Sy (Loop_Parameter_Specification, Node_Id, Default_Empty), + Sm (Condition_Actions, List_Id))); + + Cc (N_Terminate_Alternative, Node_Kind, + (Sy (Condition, Node_Id, Default_Empty), + Sy (Pragmas_Before, List_Id, Default_No_List), + Sy (Pragmas_After, List_Id, Default_No_List))); + + Ab (N_Formal_Subprogram_Declaration, Node_Kind); + + Cc (N_Formal_Abstract_Subprogram_Declaration, N_Formal_Subprogram_Declaration, + (Sy (Specification, Node_Id), + Sy (Default_Name, Node_Id, Default_Empty), + Sy (Box_Present, Flag))); + + Cc (N_Formal_Concrete_Subprogram_Declaration, N_Formal_Subprogram_Declaration, + (Sy (Specification, Node_Id), + Sy (Default_Name, Node_Id, Default_Empty), + Sy (Box_Present, Flag))); + + Ab (N_Push_Pop_xxx_Label, Node_Kind); + + Ab (N_Push_xxx_Label, N_Push_Pop_xxx_Label, + (Sm (Exception_Label, Node_Id))); + + Cc (N_Push_Constraint_Error_Label, N_Push_xxx_Label); + + Cc (N_Push_Program_Error_Label, N_Push_xxx_Label); + + Cc (N_Push_Storage_Error_Label, N_Push_xxx_Label); + + Ab (N_Pop_xxx_Label, N_Push_Pop_xxx_Label); + + Cc (N_Pop_Constraint_Error_Label, N_Pop_xxx_Label); + + Cc (N_Pop_Program_Error_Label, N_Pop_xxx_Label); + + Cc (N_Pop_Storage_Error_Label, N_Pop_xxx_Label); + + Ab (N_SCIL_Node, Node_Kind, + (Sm (SCIL_Entity, Node_Id))); + + Cc (N_SCIL_Dispatch_Table_Tag_Init, N_SCIL_Node); + + Cc (N_SCIL_Dispatching_Call, N_SCIL_Node, + (Sm (SCIL_Controlling_Tag, Node_Id), + Sm (SCIL_Target_Prim, Node_Id))); + + Cc (N_SCIL_Membership_Test, N_SCIL_Node, + (Sm (SCIL_Tag_Value, Node_Id))); + + Cc (N_Abortable_Part, Node_Kind, + (Sy (Statements, List_Id, Default_Empty_List))); + + Cc (N_Abstract_Subprogram_Declaration, Node_Kind, + (Sy (Specification, Node_Id))); + + Cc (N_Access_Definition, Node_Kind, + (Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (All_Present, Flag), + Sy (Constant_Present, Flag), + Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Access_To_Subprogram_Definition, Node_Id, Default_Empty))); + + Cc (N_Access_To_Object_Definition, Node_Kind, + (Sy (All_Present, Flag), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Null_Excluding_Subtype, Flag), + Sy (Subtype_Indication, Node_Id, Default_Empty), + Sy (Constant_Present, Flag))); + + Cc (N_Aspect_Specification, Node_Kind, + (Sy (Identifier, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sy (Class_Present, Flag), + Sy (Split_PPC, Flag), + Sm (Aspect_On_Partial_View, Flag), + Sm (Aspect_Rep_Item, Node_Id), + Sm (Entity_Or_Associated_Node, Node_Id), -- just Entity + Sm (Is_Boolean_Aspect, Flag), + Sm (Is_Checked, Flag), + Sm (Is_Delayed_Aspect, Flag), + Sm (Is_Disabled, Flag), + Sm (Is_Ignored, Flag), + Sm (Next_Rep_Item, Node_Id))); + + Cc (N_Call_Marker, Node_Kind, + (Sm (Is_Declaration_Level_Node, Flag), + Sm (Is_Dispatching_Call, Flag), + Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_Known_Guaranteed_ABE, Flag), + Sm (Is_Preelaborable_Call, Flag), + Sm (Is_Source_Call, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (Target, Node_Id))); + + Cc (N_Case_Expression_Alternative, Node_Kind, + (Sm (Actions, List_Id), + Sy (Discrete_Choices, List_Id), + Sy (Expression, Node_Id, Default_Empty), + Sm (Has_SP_Choice, Flag))); + + Cc (N_Case_Statement_Alternative, Node_Kind, + (Sy (Discrete_Choices, List_Id), + Sy (Statements, List_Id, Default_Empty_List), + Sm (Has_SP_Choice, Flag))); + + Cc (N_Compilation_Unit, Node_Kind, + (Sy (Context_Items, List_Id), + Sy (Private_Present, Flag), + Sy (Unit, Node_Id), + Sy (Aux_Decls_Node, Node_Id), + Sm (Acts_As_Spec, Flag), + Sm (Body_Required, Flag), + Sm (Context_Pending, Flag), + Sm (First_Inlined_Subprogram, Node_Id), + Sm (Has_No_Elaboration_Code, Flag), + Sm (Has_Pragma_Suppress_All, Flag), + Sm (Library_Unit, Node_Id), + Sm (Save_Invocation_Graph_Of_Body, Flag))); + + Cc (N_Compilation_Unit_Aux, Node_Kind, + (Sy (Declarations, List_Id, Default_No_List), + Sy (Actions, List_Id, Default_No_List), + Sy (Pragmas_After, List_Id, Default_No_List), + Sy (Config_Pragmas, List_Id, Default_Empty_List), + Sm (Default_Storage_Pool, Node_Id))); + + Cc (N_Component_Association, Node_Kind, + (Sy (Choices, List_Id), + Sy (Expression, Node_Id, Default_Empty), + Sy (Box_Present, Flag), + Sy (Inherited_Discriminant, Flag), + Sm (Loop_Actions, List_Id), + Sm (Was_Default_Init_Box_Association, Flag))); + + Cc (N_Component_Definition, Node_Kind, + (Sy (Aliased_Present, Flag), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Subtype_Indication, Node_Id, Default_Empty), + Sy (Access_Definition, Node_Id, Default_Empty))); + + Cc (N_Component_List, Node_Kind, + (Sy (Component_Items, List_Id), + Sy (Variant_Part, Node_Id, Default_Empty), + Sy (Null_Present, Flag))); + + Cc (N_Contract, Node_Kind, + (Sm (Classifications, Node_Id), + Sm (Contract_Test_Cases, Node_Id), + Sm (Is_Expanded_Contract, Flag), + Sm (Pre_Post_Conditions, Node_Id))); + + Cc (N_Derived_Type_Definition, Node_Kind, + (Sy (Abstract_Present, Flag), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Subtype_Indication, Node_Id, Default_Empty), + Sy (Record_Extension_Part, Node_Id, Default_Empty), + Sy (Limited_Present, Flag), + Sy (Task_Present, Flag), + Sy (Protected_Present, Flag), + Sy (Synchronized_Present, Flag), + Sy (Interface_List, List_Id, Default_No_List), + Sy (Interface_Present, Flag))); + + Cc (N_Decimal_Fixed_Point_Definition, Node_Kind, + (Sy (Delta_Expression, Node_Id), + Sy (Digits_Expression, Node_Id), + Sy (Real_Range_Specification, Node_Id, Default_Empty))); + + Cc (N_Defining_Program_Unit_Name, Node_Kind, + (Sy (Name, Node_Id, Default_Empty), + Sy (Defining_Identifier, Node_Id))); + + Cc (N_Delta_Constraint, Node_Kind, + (Sy (Delta_Expression, Node_Id), + Sy (Range_Constraint, Node_Id, Default_Empty))); + + Cc (N_Designator, Node_Kind, + (Sy (Name, Node_Id, Default_Empty), + Sy (Identifier, Node_Id, Default_Empty))); + + Cc (N_Digits_Constraint, Node_Kind, + (Sy (Digits_Expression, Node_Id), + Sy (Range_Constraint, Node_Id, Default_Empty))); + + Cc (N_Discriminant_Association, Node_Kind, + (Sy (Selector_Names, List_Id), + Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_Discriminant_Specification, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Discriminant_Type, Node_Id), + Sy (Expression, Node_Id, Default_Empty), + Sm (More_Ids, Flag), + Sm (Prev_Ids, Flag))); + + Cc (N_Enumeration_Type_Definition, Node_Kind, + (Sy (Literals, List_Id), + Sy (End_Label, Node_Id, Default_Empty))); + + Cc (N_Entry_Body, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Entry_Body_Formal_Part, Node_Id), + Sy (Declarations, List_Id, Default_No_List), + Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), + Sm (Activation_Chain_Entity, Node_Id))); + + Cc (N_Entry_Call_Alternative, Node_Kind, + (Sy (Entry_Call_Statement, Node_Id), + Sy (Statements, List_Id, Default_Empty_List), + Sy (Pragmas_Before, List_Id, Default_No_List))); + + Cc (N_Entry_Index_Specification, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Discrete_Subtype_Definition, Node_Id, Default_Empty))); + + Cc (N_Exception_Declaration, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sm (Expression, Node_Id), + Sm (More_Ids, Flag), + Sm (Prev_Ids, Flag), + Sm (Renaming_Exception, Node_Id))); + + Cc (N_Exception_Handler, Node_Kind, + (Sy (Choice_Parameter, Node_Id, Default_Empty), + Sy (Exception_Choices, List_Id), + Sy (Statements, List_Id, Default_Empty_List), + Sm (Exception_Label, Node_Id), + Sm (Has_Local_Raise, Flag), + Sm (Local_Raise_Not_OK, Flag), + Sm (Local_Raise_Statements, Elist_Id))); + + Cc (N_Floating_Point_Definition, Node_Kind, + (Sy (Digits_Expression, Node_Id), + Sy (Real_Range_Specification, Node_Id, Default_Empty))); + + Cc (N_Formal_Decimal_Fixed_Point_Definition, Node_Kind); + + Cc (N_Formal_Derived_Type_Definition, Node_Kind, + (Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Private_Present, Flag), + Sy (Abstract_Present, Flag), + Sy (Limited_Present, Flag), + Sy (Synchronized_Present, Flag), + Sy (Interface_List, List_Id, Default_No_List))); + + Cc (N_Formal_Discrete_Type_Definition, Node_Kind); + + Cc (N_Formal_Floating_Point_Definition, Node_Kind); + + Cc (N_Formal_Modular_Type_Definition, Node_Kind); + + Cc (N_Formal_Ordinary_Fixed_Point_Definition, Node_Kind); + + Cc (N_Formal_Package_Declaration, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Name, Node_Id, Default_Empty), + Sy (Generic_Associations, List_Id, Default_No_List), + Sy (Box_Present, Flag), + Sm (Instance_Spec, Node_Id), + Sm (Is_Known_Guaranteed_ABE, Flag))); + + Cc (N_Formal_Private_Type_Definition, Node_Kind, + (Sy (Abstract_Present, Flag), + Sy (Tagged_Present, Flag), + Sy (Limited_Present, Flag), + Sm (Uninitialized_Variable, Node_Id))); + + Cc (N_Formal_Incomplete_Type_Definition, Node_Kind, + (Sy (Tagged_Present, Flag))); + + Cc (N_Formal_Signed_Integer_Type_Definition, Node_Kind); + + Cc (N_Freeze_Entity, Node_Kind, + (Sy (Actions, List_Id, Default_No_List), + Sm (Access_Types_To_Process, Elist_Id), + Sm (Entity_Or_Associated_Node, Node_Id), -- just Entity + Sm (First_Subtype_Link, Node_Id), + Sm (TSS_Elist, Elist_Id))); + + Cc (N_Freeze_Generic_Entity, Node_Kind, + Sm (Entity_Or_Associated_Node, Node_Id)); -- just Entity + + Cc (N_Generic_Association, Node_Kind, + (Sy (Selector_Name, Node_Id, Default_Empty), + Sy (Explicit_Generic_Actual_Parameter, Node_Id), + Sy (Box_Present, Flag))); + + Cc (N_Handled_Sequence_Of_Statements, Node_Kind, + (Sy (Statements, List_Id, Default_Empty_List), + Sy (End_Label, Node_Id, Default_Empty), + Sy (Exception_Handlers, List_Id, Default_No_List), + Sy (At_End_Proc, Node_Id, Default_Empty), + Sm (First_Real_Statement, Node_Id))); + + Cc (N_Index_Or_Discriminant_Constraint, Node_Kind, + (Sy (Constraints, List_Id))); + + Cc (N_Iterated_Component_Association, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Iterator_Specification, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sy (Discrete_Choices, List_Id), + Sy (Box_Present, Flag), + Sm (Loop_Actions, List_Id))); + + Cc (N_Iterated_Element_Association, Node_Kind, + (Sy (Key_Expression, Node_Id), + Sy (Iterator_Specification, Node_Id, Default_Empty), + Sy (Expression, Node_Id, Default_Empty), + Sy (Loop_Parameter_Specification, Node_Id, Default_Empty), + Sy (Box_Present, Flag), + Sm (Loop_Actions, List_Id))); + + Cc (N_Itype_Reference, Node_Kind, + (Sm (Itype, Node_Id))); + + Cc (N_Label, Node_Kind, + (Sy (Identifier, Node_Id, Default_Empty), + Sm (Exception_Junk, Flag))); + + Cc (N_Modular_Type_Definition, Node_Kind, + (Sy (Expression, Node_Id, Default_Empty))); + + Cc (N_Number_Declaration, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Expression, Node_Id, Default_Empty), + Sm (More_Ids, Flag), + Sm (Prev_Ids, Flag))); + + Cc (N_Ordinary_Fixed_Point_Definition, Node_Kind, + (Sy (Delta_Expression, Node_Id), + Sy (Real_Range_Specification, Node_Id, Default_Empty))); + + Cc (N_Others_Choice, Node_Kind, + (Sm (All_Others, Flag), + Sm (Others_Discrete_Choices, List_Id))); + + Cc (N_Package_Specification, Node_Kind, + (Sy (Defining_Unit_Name, Node_Id), + Sy (Visible_Declarations, List_Id), + Sy (Private_Declarations, List_Id, Default_No_List), + Sy (End_Label, Node_Id, Default_Empty), + Sm (Generic_Parent, Node_Id), + Sm (Limited_View_Installed, Flag))); + + Cc (N_Parameter_Association, Node_Kind, + (Sy (Selector_Name, Node_Id, Default_Empty), + Sy (Explicit_Actual_Parameter, Node_Id), + Sm (Is_Accessibility_Actual, Flag), + Sm (Next_Named_Actual, Node_Id))); + + Cc (N_Parameter_Specification, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Aliased_Present, Flag), + Sy (In_Present, Flag), + Sy (Out_Present, Flag), + Sy (Null_Exclusion_Present, Flag, Default_False), + Sy (Parameter_Type, Node_Id), + Sy (Expression, Node_Id, Default_Empty), + Sm (Default_Expression, Node_Id), + Sm (Do_Accessibility_Check, Flag), + Sm (More_Ids, Flag), + Sm (Prev_Ids, Flag))); + + Cc (N_Pragma, Node_Kind, + (Sy (Pragma_Argument_Associations, List_Id, Default_No_List), + Sy (Pragma_Identifier, Node_Id), + Sy (Class_Present, Flag), + Sy (Split_PPC, Flag), + Sm (Corresponding_Aspect, Node_Id), + Sm (From_Aspect_Specification, Flag), + Sm (Import_Interface_Present, Flag), + Sm (Is_Analyzed_Pragma, Flag), + Sm (Is_Checked, Flag), + Sm (Is_Checked_Ghost_Pragma, Flag), + Sm (Is_Delayed_Aspect, Flag), + Sm (Is_Disabled, Flag), + Sm (Is_Generic_Contract_Pragma, Flag), + Sm (Is_Ignored, Flag), + Sm (Is_Ignored_Ghost_Pragma, Flag), + Sm (Is_Inherited_Pragma, Flag), + Sm (Next_Pragma, Node_Id), + Sm (Next_Rep_Item, Node_Id), + Sm (Uneval_Old_Accept, Flag), + Sm (Uneval_Old_Warn, Flag))); + + Cc (N_Protected_Definition, Node_Kind, + (Sy (Visible_Declarations, List_Id), + Sy (Private_Declarations, List_Id, Default_No_List), + Sy (End_Label, Node_Id, Default_Empty))); + + Cc (N_Range_Constraint, Node_Kind, + (Sy (Range_Expression, Node_Id))); + + Cc (N_Real_Range_Specification, Node_Kind, + (Sy (Low_Bound, Node_Id), + Sy (High_Bound, Node_Id))); + + Cc (N_Record_Definition, Node_Kind, + (Sy (End_Label, Node_Id, Default_Empty), + Sy (Abstract_Present, Flag), + Sy (Tagged_Present, Flag), + Sy (Limited_Present, Flag), + Sy (Component_List, Node_Id), + Sy (Null_Present, Flag), + Sy (Task_Present, Flag), + Sy (Protected_Present, Flag), + Sy (Synchronized_Present, Flag), + Sy (Interface_Present, Flag), + Sy (Interface_List, List_Id, Default_No_List))); + + Cc (N_Signed_Integer_Type_Definition, Node_Kind, + (Sy (Low_Bound, Node_Id), + Sy (High_Bound, Node_Id))); + + Cc (N_Single_Protected_Declaration, Node_Kind, + (Sy (Defining_Identifier, Node_Id), + Sy (Interface_List, List_Id, Default_No_List), + Sy (Protected_Definition, Node_Id))); + + Cc (N_Subunit, Node_Kind, + (Sy (Name, Node_Id, Default_Empty), + Sy (Proper_Body, Node_Id), + Sm (Corresponding_Stub, Node_Id))); + + Cc (N_Task_Definition, Node_Kind, + (Sy (Visible_Declarations, List_Id), + Sy (Private_Declarations, List_Id, Default_No_List), + Sy (End_Label, Node_Id, Default_Empty), + Sm (Has_Relative_Deadline_Pragma, Flag), + Sm (Has_Storage_Size_Pragma, Flag))); + + Cc (N_Triggering_Alternative, Node_Kind, + (Sy (Triggering_Statement, Node_Id), + Sy (Statements, List_Id, Default_Empty_List), + Sy (Pragmas_Before, List_Id, Default_No_List))); + + Cc (N_Use_Type_Clause, Node_Kind, + (Sy (Subtype_Mark, Node_Id, Default_Empty), + Sy (Is_Effective_Use_Clause, Flag), + Sy (All_Present, Flag), + Sm (Hidden_By_Use_Clause, Elist_Id), + Sm (More_Ids, Flag), + Sm (Next_Use_Clause, Node_Id), + Sm (Prev_Ids, Flag), + Sm (Prev_Use_Clause, Node_Id), + Sm (Used_Operations, Elist_Id))); + + Cc (N_Validate_Unchecked_Conversion, Node_Kind, + (Sm (Source_Type, Node_Id), + Sm (Target_Type, Node_Id))); + + Cc (N_Variable_Reference_Marker, Node_Kind, + (Sm (Is_Elaboration_Checks_OK_Node, Flag), + Sm (Is_Elaboration_Warnings_OK_Node, Flag), + Sm (Is_Read, Flag), + Sm (Is_SPARK_Mode_On_Node, Flag), + Sm (Is_Write, Flag), + Sm (Target, Node_Id))); + + Cc (N_Variant, Node_Kind, + (Sy (Discrete_Choices, List_Id), + Sy (Component_List, Node_Id), + Sm (Dcheck_Function, Node_Id), + Sm (Enclosing_Variant, Node_Id), + Sm (Has_SP_Choice, Flag), + Sm (Present_Expr, Uint))); + + Cc (N_Variant_Part, Node_Kind, + (Sy (Name, Node_Id, Default_Empty), + Sy (Variants, List_Id))); + + Cc (N_With_Clause, Node_Kind, + (Sy (Name, Node_Id, Default_Empty), + Sy (Private_Present, Flag), + Sy (Limited_Present, Flag), + Sy (First_Name, Flag, Default_True), + Sy (Last_Name, Flag, Default_True), + Sm (Context_Installed, Flag), + Sm (Corresponding_Spec, Node_Id), + Sm (Elaborate_All_Desirable, Flag), + Sm (Elaborate_All_Present, Flag), + Sm (Elaborate_Desirable, Flag), + Sm (Elaborate_Present, Flag), + Sm (Implicit_With, Flag), + Sm (Library_Unit, Node_Id), + Sm (Limited_View_Installed, Flag), + Sm (Next_Implicit_With, Node_Id), + Sm (No_Entities_Ref_In_Spec, Flag), + Sm (Parent_With, Flag), + Sm (Unreferenced_In_Spec, Flag))); + + Cc (N_Unused_At_End, Node_Kind); + + -- Union types. These don't fit into the normal parent/child hierarchy + -- above. + + Union (N_Has_Chars, + Children => + (N_Attribute_Definition_Clause, + N_Empty, + N_Pragma_Argument_Association, + N_Error, + N_Entity, + N_Expanded_Name, + N_Identifier, + N_Operator_Symbol, + N_Character_Literal, + N_Op)); + + Union (N_Has_Condition, + Children => + (N_Exit_Statement, + N_If_Statement, + N_Accept_Alternative, + N_Delay_Alternative, + N_Elsif_Part, + N_Entry_Body_Formal_Part, + N_Iteration_Scheme, + N_Terminate_Alternative)); + -- Nodes with condition fields (does not include N_Raise_xxx_Error) + +end Gen_IL.Gen.Gen_Nodes; diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb new file mode 100644 index 00000000000..137338c569c --- /dev/null +++ b/gcc/ada/gen_il-gen.adb @@ -0,0 +1,2974 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . G E N -- +-- -- +-- 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 Ada.Containers; use type Ada.Containers.Count_Type; + +package body Gen_IL.Gen is + + Enable_Assertions : constant Boolean := True; + -- True to enable predicates on the _Id types, and preconditions on getters + -- and setters. + + Overlay_Fields : constant Boolean := True; + -- False to allocate every field so it doesn't overlay any other fields, + -- which results in enormous nodes. For experimenting and debugging. + -- Should be True in normal operation, for efficiency. + + Inline : constant String := "Inline"; + -- For experimenting with Inline_Always + + Is_Syntactic : Fields_Per_Node_Type := + (others => (others => False)); + + Nodes_And_Entities : constant Type_Vector := Node_Kind & Entity_Kind; + All_Entities : constant Type_Vector := To_Vector (Entity_Kind, Length => 1); + + procedure Create_Type + (T : Node_Or_Entity_Type; Parent : Opt_Abstract_Type; + Fields : Field_Sequence); + -- Called by the Create_..._Type procedures exported by this package to + -- create an entry in the Types_Table. + + procedure Create_Union_Type + (Root : Root_Type; T : Abstract_Type; Children : Type_Array); + -- Called by Create_Node_Union and Create_Entity_Union to create a union + -- type. + + function Create_Field + (Field : Field_Enum; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value; + Type_Only : Type_Only_Enum; + Pre : String; + Is_Syntactic : Boolean) return Field_Desc; + -- Called by the Create_..._Field functions exported by this package to + -- create an entry in the Field_Table. See Create_Syntactic_Field and + -- Create_Semantic_Field for additional doc. + + procedure Check_Type (T : Node_Or_Entity_Type); + -- Check some "legality" rules + + procedure Check_Type (T : Node_Or_Entity_Type) is + Im : constant String := Node_Or_Entity_Type'Image (T); + begin + if Type_Table (T) /= null then + raise Illegal with "duplicate creation of type " & Image (T); + end if; + + if T not in Root_Type then + case T is + when Node_Type => + if Im'Length < 2 or else Im (1 .. 2) /= "N_" then + raise Illegal with "Node type names must start with ""N_"""; + end if; + + when Concrete_Entity => + if Im'Length < 2 or else Im (1 .. 2) /= "E_" then + raise Illegal with + "Concrete entity type names must start with ""E_"""; + end if; + + when others => null; + -- No special prefix for abstract entities + end case; + end if; + end Check_Type; + + procedure Create_Type + (T : Node_Or_Entity_Type; Parent : Opt_Abstract_Type; + Fields : Field_Sequence) + is + begin + Check_Type (T); + + if T not in Root_Type then + if Type_Table (Parent) = null then + raise Illegal with + "undefined parent type for " & + Image (T) & " (parent is " & Image (Parent) & ")"; + end if; + + if Type_Table (Parent).Is_Union then + raise Illegal with + "parent type for " & + Image (T) & " must not be union (" & Image (Parent) & ")"; + end if; + end if; + + Type_Table (T) := + new Type_Info' + (Is_Union => False, Parent => Parent, + Children | Concrete_Descendants => Type_Vectors.Empty_Vector, + First | Last | Fields => <>, + Allow_Overlap => False); + + if Parent /= No_Type then + Append (Type_Table (Parent).Children, T); + end if; + + -- Check that syntactic fields precede semantic fields. Note that this + -- check is happening before we compute inherited fields. + -- ????Exempt Chars and Actions from this rule, for now. + + declare + Semantic_Seen : Boolean := False; + begin + for J in Fields'Range loop + if Fields (J).Is_Syntactic then + if Semantic_Seen then + raise Illegal with + "syntactic fields must precede semantic ones " & Image (T); + end if; + + else + if Fields (J).F not in Chars | Actions then + Semantic_Seen := True; + end if; + end if; + end loop; + end; + + for J in Fields'Range loop + declare + Field : constant Field_Enum := Fields (J).F; + Is_Syntactic : constant Boolean := Fields (J).Is_Syntactic; + + begin + Append (Field_Table (Field).Have_This_Field, T); + Append (Type_Table (T).Fields, Field); + + pragma Assert (not Gen.Is_Syntactic (T) (Field)); + Gen.Is_Syntactic (T) (Field) := Is_Syntactic; + end; + end loop; + end Create_Type; + + -- Other than constraint checks on T at the call site, and the lack of a + -- parent for root types, the following six all do the same thing. + + procedure Create_Root_Node_Type + (T : Abstract_Node; + Fields : Field_Sequence := No_Fields) is + begin + Create_Type (T, Parent => No_Type, Fields => Fields); + end Create_Root_Node_Type; + + procedure Create_Abstract_Node_Type + (T : Abstract_Node; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + is + begin + Create_Type (T, Parent, Fields); + end Create_Abstract_Node_Type; + + procedure Create_Concrete_Node_Type + (T : Concrete_Node; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + is + begin + Create_Type (T, Parent, Fields); + end Create_Concrete_Node_Type; + + procedure Create_Root_Entity_Type + (T : Abstract_Entity; + Fields : Field_Sequence := No_Fields) is + begin + Create_Type (T, Parent => No_Type, Fields => Fields); + end Create_Root_Entity_Type; + + procedure Create_Abstract_Entity_Type + (T : Abstract_Entity; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + is + begin + Create_Type (T, Parent, Fields); + end Create_Abstract_Entity_Type; + + procedure Create_Concrete_Entity_Type + (T : Concrete_Entity; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields) + is + begin + Create_Type (T, Parent, Fields); + end Create_Concrete_Entity_Type; + + function Create_Field + (Field : Field_Enum; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value; + Type_Only : Type_Only_Enum; + Pre : String; + Is_Syntactic : Boolean) return Field_Desc + is + begin + pragma Assert (if Default_Value /= No_Default then Is_Syntactic); + pragma Assert (if Type_Only /= No_Type_Only then not Is_Syntactic); + + if Field_Table (Field) = null then + Field_Table (Field) := new Field_Info' + (Type_Vectors.Empty_Vector, Field_Type, Default_Value, Type_Only, + Pre => new String'(Pre), Offset => <>); + + else + if Field_Type /= Field_Table (Field).Field_Type then + raise Illegal with + "mismatched field types for " & Image (Field); + end if; + + -- Check that default values for syntactic fields match. This check + -- could be stricter; it currently allows a field to have No_Default + -- in one type, but something else in another type. In that case, we + -- use the "something else" for all types. + + if Is_Syntactic then + if Default_Value /= Field_Table (Field).Default_Value then + if Field_Table (Field).Default_Value = No_Default then + Field_Table (Field).Default_Value := Default_Value; + else + raise Illegal with + "mismatched default values for " & Image (Field); + end if; + end if; + end if; + + if Type_Only /= Field_Table (Field).Type_Only then + raise Illegal with "mismatched Type_Only for " & Image (Field); + end if; + + if Pre /= Field_Table (Field).Pre.all then + raise Illegal with + "mismatched extra preconditions for " & Image (Field); + end if; + end if; + + return (Field, Is_Syntactic); + end Create_Field; + + function Create_Syntactic_Field + (Field : Node_Field; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value := No_Default; + Pre : String := "") return Field_Desc + is + begin + return Create_Field + (Field, Field_Type, Default_Value, No_Type_Only, Pre, + Is_Syntactic => True); + end Create_Syntactic_Field; + + function Create_Semantic_Field + (Field : Field_Enum; + Field_Type : Type_Enum; + Type_Only : Type_Only_Enum := No_Type_Only; + Pre : String := "") return Field_Desc + is + begin + return Create_Field + (Field, Field_Type, No_Default, Type_Only, Pre, Is_Syntactic => False); + end Create_Semantic_Field; + + procedure Create_Union_Type + (Root : Root_Type; T : Abstract_Type; Children : Type_Array) + is + Children_Seen : Type_Set := (others => False); + + begin + Check_Type (T); + + if Children'Length <= 1 then + raise Illegal with Image (T) & " must have two or more children"; + end if; + + for Child of Children loop + if Children_Seen (Child) then + raise Illegal with + Image (T) & " has duplicate child " & Image (Child); + end if; + + Children_Seen (Child) := True; + + if Type_Table (Child) = null then + raise Illegal with + "undefined child type for " & + Image (T) & " (child is " & Image (Child) & ")"; + end if; + end loop; + + Type_Table (T) := + new Type_Info' + (Is_Union => True, Parent => Root, + Children | Concrete_Descendants => Type_Vectors.Empty_Vector); + + for Child of Children loop + Append (Type_Table (T).Children, Child); + end loop; + end Create_Union_Type; + + procedure Create_Node_Union (T : Abstract_Node; Children : Type_Array) is + begin + Create_Union_Type (Node_Kind, T, Children); + end Create_Node_Union; + + procedure Create_Entity_Union + (T : Abstract_Entity; Children : Type_Array) is + begin + Create_Union_Type (Entity_Kind, T, Children); + end Create_Entity_Union; + + procedure Compile is + Fields_Per_Node : Fields_Per_Node_Type := (others => (others => False)); + + Type_Bit_Size : array (Concrete_Type) of Bit_Offset := (others => 0); + Min_Node_Bit_Size : Bit_Offset := Bit_Offset'Last; + Max_Node_Bit_Size : Bit_Offset := 0; + Min_Entity_Bit_Size : Bit_Offset := Bit_Offset'Last; + Max_Entity_Bit_Size : Bit_Offset := 0; + -- Above are in units of bits; following are in units of slots: + Min_Node_Size : Field_Offset := Field_Offset'Last; + Max_Node_Size : Field_Offset := 0; + Min_Entity_Size : Field_Offset := Field_Offset'Last; + Max_Entity_Size : Field_Offset := 0; + + Average_Node_Size_In_Slots : Long_Float; + + Node_Field_Types_Used, Entity_Field_Types_Used : Type_Set; + + Setter_Needs_Parent : Field_Set := + (Actions | Expression | Else_Actions => True, others => False); + -- Set of fields where the setter should set the Parent. True for + -- syntactic fields of type Node_Id and List_Id, but with some + -- exceptions. Expression and Else_Actions are syntactic AND semantic, + -- and the Parent is needed. Default_Expression is also both, but the + -- Parent is not needed. Else_Actions is not syntactic, but the Parent + -- is needed. + + procedure Check_Completeness; + -- Check that every type and field has been declared + + procedure Compute_Ranges (Root : Root_Type); + -- Compute the range of Node_Kind/Entity_Kind values for all the types + -- rooted at Root. + + procedure Compute_Fields_Per_Node; + -- Compute which fields are in which nodes. Implements inheritance of + -- fields. Set the Fields component of each Type_Info to include + -- inherited ones. Set the Is_Syntactic component to the set of fields + -- that are syntactic in that node kind. Set the Fields_Per_Node table. + + procedure Compute_Field_Offsets; + -- Compute the offsets of each field. + + procedure Compute_Type_Sizes; + -- Compute the size of each node and entity type, which is one more than + -- the maximum bit offset of all fields of the type. Results are + -- returned in the above Type_Bit_Size and Min_.../Max_... variables. + + procedure Check_For_Syntactic_Mismatch; + -- Check that fields are either all syntactic or all semantic in all + -- nodes in which they exist, except for some fields that are + -- grandfathered in. + -- + -- Also sets Setter_Needs_Parent. + + function Field_Types_Used (First, Last : Field_Enum) return Type_Set; + -- Returns the union of the types of all the fields in the range First + -- .. Last. Only Special_Type; if the declared type of a field is a + -- descendant of Node_Kind or Entity_Kind, then the low-level getter for + -- Node_Id can be used. + + procedure Put_Seinfo; + -- Print out the Seinfo package, which is with'ed by both Sinfo.Nodes + -- and Einfo.Entities. + + procedure Put_Nodes; + -- Print out the Sinfo.Nodes package spec and body + + procedure Put_Entities; + -- Print out the Einfo.Entities package spec and body + + procedure Put_Type_And_Subtypes + (S : in out Sink'Class; 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); + -- 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); + -- Called by Put_Nodes and Put_Entities to print out the subprogram + -- bodies in Sinfo.Nodes and Einfo.Entities. + + function Node_To_Fetch_From (F : Field_Enum) return String; + -- Node from which a getter should fetch the value. + -- Normally, we fetch from the node or entity passed in (i.e. formal + -- parameter N). But if Type_Only was specified, we need to fetch the + -- corresponding base (etc) type. + -- ????We should not allocate space in the node for subtypes (etc), but + -- that's not necessary for it to work. + + 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); + -- 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); + -- Print out the precondition, if any, for a getter or setter for the + -- given field. + + procedure Instantiate_Low_Level_Accessors + (S : in out Sink'Class; T : Type_Enum); + -- Print out the low-level getter and setter for a given type + + procedure Put_Traversed_Fields (S : in out Sink'Class); + -- 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); + -- Called by Put_Nodes and Put_Entities to print out the various tables + -- in Sinfo.Nodes and Einfo.Entities. + + procedure Put_Nmake; + -- 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); + -- Called by Put_Nmake to print out the Make_... function declarations + + procedure Put_Make_Bodies (S : in out Sink'Class; 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); + -- Called by Put_Make_Decls and Put_Make_Bodies to print out the spec of + -- a single Make_... function. + + procedure Put_Seinfo_Tables; + -- This puts information about both sinfo and einfo. + -- Not actually needed by the compiler. + + procedure Put_Sinfo_Dot_H; + -- Print out the sinfo.h file + + procedure Put_Einfo_Dot_H; + -- Print out the einfo.h file + + procedure Put_C_Type_And_Subtypes + (S : in out Sink'Class; 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); + -- 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); + -- 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); + -- 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); + -- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out functions to + -- test membership in a union type. + + procedure Check_Completeness is + begin + for T in Node_Or_Entity_Type loop + if Type_Table (T) = null and then T not in Boundaries then + raise Illegal with "Missing type declaration for " & Image (T); + end if; + end loop; + + for F in Field_Enum loop + if Field_Table (F) = null + and then F /= Between_Node_And_Entity_Fields + then + raise Illegal with "Missing field declaration for " & Image (F); + end if; + end loop; + end Check_Completeness; + + procedure Compute_Ranges (Root : Root_Type) is + + procedure Do_One_Type (T : Node_Or_Entity_Type); + -- Compute the range for one type. Passed to Iterate_Types to process + -- all of them. + + procedure Add_Concrete_Descendant + (Ancestor : Abstract_Type; Descendant : Concrete_Type); + -- Add Descendant to the Concrete_Descendants of each of its + -- ancestors. + + procedure Add_Concrete_Descendant + (Ancestor : Abstract_Type; Descendant : Concrete_Type) is + begin + if Ancestor not in Root_Type then + Add_Concrete_Descendant + (Type_Table (Ancestor).Parent, Descendant); + end if; + + Append (Type_Table (Ancestor).Concrete_Descendants, Descendant); + end Add_Concrete_Descendant; + + procedure Do_One_Type (T : Node_Or_Entity_Type) is + begin + case T is + when Concrete_Type => + pragma Annotate (Codepeer, Modified, Type_Table); + Type_Table (T).First := T; + Type_Table (T).Last := T; + Add_Concrete_Descendant (Type_Table (T).Parent, T); + + when Abstract_Type => + declare + Children : Type_Vector renames Type_Table (T).Children; + begin + -- Ensure that an abstract type is not a leaf in the type + -- hierarchy. + + if Is_Empty (Children) then + raise Illegal with Image (T) & " has no children"; + end if; + + -- We could support abstract types with only one child, + -- but what's the point of having such a type? + + if Last_Index (Children) = 1 then + raise Illegal with Image (T) & " has only one child"; + end if; + + Type_Table (T).First := Type_Table (Children (1)).First; + Type_Table (T).Last := + Type_Table (Children (Last_Index (Children))).Last; + end; + + when Between_Abstract_Entity_And_Concrete_Node_Types => + raise Program_Error; + end case; + end Do_One_Type; + begin + Iterate_Types (Root, Post => Do_One_Type'Access); + end Compute_Ranges; + + procedure Compute_Fields_Per_Node is + + Duplicate_Fields_Found : Boolean := False; + + function Get_Fields (T : Node_Or_Entity_Type) return Field_Vector; + -- Compute the fields of a given type. This is the fields inherited + -- from ancestors, plus the fields declared for the type itself. + + function Get_Is_Syntactic (T : Node_Or_Entity_Type) return Field_Set; + -- Compute the set of fields that are syntactic for a given type. + -- Note that a field can be syntactic in some node types, but + -- semantic in others. + + procedure Do_Concrete_Type (CT : Concrete_Type); + + function Get_Fields (T : Node_Or_Entity_Type) return Field_Vector is + Parent_Fields : constant Field_Vector := + (if T in Root_Type then Field_Vectors.Empty_Vector + else Get_Fields (Type_Table (T).Parent)); + begin + return Parent_Fields & Type_Table (T).Fields; + end Get_Fields; + + function Get_Is_Syntactic (T : Node_Or_Entity_Type) return Field_Set + is + Parent_Is_Syntactic : constant Field_Set := + (if T in Root_Type then (Field_Enum => False) + else Get_Is_Syntactic (Type_Table (T).Parent)); + begin + return Parent_Is_Syntactic or Is_Syntactic (T); + end Get_Is_Syntactic; + + procedure Do_Concrete_Type (CT : Concrete_Type) is + begin + Type_Table (CT).Fields := Get_Fields (CT); + Is_Syntactic (CT) := Get_Is_Syntactic (CT); + + 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)); + Duplicate_Fields_Found := True; + end if; + + Fields_Per_Node (CT) (F) := True; + end loop; + end Do_Concrete_Type; + + begin -- Compute_Fields_Per_Node + for CT in Concrete_Node loop + Do_Concrete_Type (CT); + end loop; + + -- The node fields defined for all three N_Entity kinds should be the + -- same: + + if Type_Table (N_Defining_Character_Literal).Fields /= + Type_Table (N_Defining_Identifier).Fields + then + raise Illegal with + "fields for N_Defining_Identifier and " & + "N_Defining_Character_Literal must match"; + end if; + + if Type_Table (N_Defining_Operator_Symbol).Fields /= + Type_Table (N_Defining_Identifier).Fields + then + raise Illegal with + "fields for N_Defining_Identifier and " & + "N_Defining_Operator_Symbol must match"; + end if; + + if Fields_Per_Node (N_Defining_Character_Literal) /= + Fields_Per_Node (N_Defining_Identifier) + then + raise Illegal with + "Fields of N_Defining_Character_Literal must match " & + "N_Defining_Identifier"; + end if; + + if Fields_Per_Node (N_Defining_Operator_Symbol) /= + Fields_Per_Node (N_Defining_Identifier) + then + raise Illegal with + "Fields of N_Defining_Operator_Symbol must match " & + "N_Defining_Identifier"; + end if; + + -- Copy node fields from N_Entity nodes to entities, so they have + -- slots allocated (but the getters and setters are only in + -- Sinfo.Nodes). + + Type_Table (Entity_Kind).Fields := + Type_Table (N_Defining_Identifier).Fields & + Type_Table (Entity_Kind).Fields; + + for CT in Concrete_Entity loop + Do_Concrete_Type (CT); + end loop; + + if Duplicate_Fields_Found then + raise Illegal with "duplicate fields found"; + end if; + end Compute_Fields_Per_Node; + + function Field_Size (T : Type_Enum) return Bit_Offset is + (case T is + when Flag | Float_Rep_Kind => 1, + when Small_Paren_Count_Type | Component_Alignment_Kind => 2, + when Nkind_Type | Ekind_Type | Convention_Id => 8, + when Mechanism_Type | List_Id | Elist_Id | Name_Id | String_Id | Uint + | Ureal | Source_Ptr | Union_Id | Node_Id + | Node_Or_Entity_Type => 32, + when Between_Special_And_Abstract_Node_Types => -- can't happen + Bit_Offset'Last); + -- Note that this is not the same as Type_Bit_Size of the field's + -- type. For one thing, Type_Bit_Size only covers concrete node and + -- entity types, which does not include most of the above. For + -- another thing, Type_Bit_Size includes the full size of all the + -- fields, whereas a field of a node or entity type is just a 32-bit + -- Node_Id or Entity_Id; i.e. it is indirect. + + function Field_Size (F : Field_Enum) return Bit_Offset is + (Field_Size (Field_Table (F).Field_Type)); + + function To_Bit_Offset (F : Field_Enum; Offset : Field_Offset) + return Bit_Offset is + (Bit_Offset (Offset) * Field_Size (F)); + function First_Bit (F : Field_Enum; Offset : Field_Offset) + return Bit_Offset is + (To_Bit_Offset (F, Offset)); + function Last_Bit (F : Field_Enum; Offset : Field_Offset) + return Bit_Offset is + (To_Bit_Offset (F, Offset + 1) - 1); + + function To_Size_In_Slots (Size_In_Bits : Bit_Offset) + return Field_Offset is + ((Field_Offset (Size_In_Bits) + 31) / 32); + + function Type_Size_In_Slots (T : Concrete_Type) return Field_Offset is + (To_Size_In_Slots (Type_Bit_Size (T))); -- rounded up to slot boundary + + function Type_Bit_Size_Aligned (T : Concrete_Type) return Bit_Offset is + (Bit_Offset (Type_Size_In_Slots (T)) * 32); -- multiple of slot size + + procedure Compute_Field_Offsets is + type Offset_Set_Unconstrained is array (Bit_Offset range <>) + of Boolean with Pack; + subtype Offset_Set is Offset_Set_Unconstrained (Bit_Offset); + Offset_Sets : array (Concrete_Type) of Offset_Set := + (others => (others => False)); + + function All_False + (F : Field_Enum; Offset : Field_Offset) + return Offset_Set_Unconstrained is + (First_Bit (F, Offset) .. Last_Bit (F, Offset) => False); + + function All_True + (F : Field_Enum; Offset : Field_Offset) + return Offset_Set_Unconstrained is + (First_Bit (F, Offset) .. Last_Bit (F, Offset) => True); + + function Offset_OK + (F : Field_Enum; Offset : Field_Offset) return Boolean; + -- True if it is OK to choose this offset; that is, if this offset is + -- not in use for any type that has the field. If Overlay_Fields is + -- False, then "any type that has the field" --> "any type, whether + -- or not it has the field". + + procedure Set_Offset_Set + (F : Field_Enum; Offset : Field_Offset); + -- Mark the offset as "in use" + + function Choose_Offset + (F : Field_Enum) return Field_Offset; + -- Choose an offset for this field + + function Offset_OK + (F : Field_Enum; Offset : Field_Offset) return Boolean is + begin + for T in Concrete_Type loop + if Fields_Per_Node (T) (F) or else not Overlay_Fields then + declare + Bits : Offset_Set_Unconstrained renames + Offset_Sets (T) + (First_Bit (F, Offset) .. Last_Bit (F, Offset)); + begin + if Bits /= All_False (F, Offset) then + return False; + end if; + end; + end if; + end loop; + + return True; + end Offset_OK; + + procedure Set_Offset_Set + (F : Field_Enum; Offset : Field_Offset) is + begin + for T in Concrete_Type loop + if Fields_Per_Node (T) (F) then + declare + Bits : Offset_Set_Unconstrained renames + Offset_Sets (T) + (First_Bit (F, Offset) .. Last_Bit (F, Offset)); + begin + pragma Assert (Bits = All_False (F, Offset)); + Bits := All_True (F, Offset); + end; + end if; + end loop; + end Set_Offset_Set; + + function Choose_Offset + (F : Field_Enum) return Field_Offset is + begin + for Offset in Field_Offset loop + if Offset_OK (F, Offset) then + Set_Offset_Set (F, Offset); + + return Offset; + end if; + end loop; + + raise Illegal with "No available field offset for " & Image (F); + end Choose_Offset; + + Num_Concrete_Have_Field : array (Field_Enum) of Type_Count := + (others => 0); + -- Number of concrete types that have each field + + function More_Types_Have_Field (F1, F2 : Field_Enum) return Boolean is + (Num_Concrete_Have_Field (F1) > Num_Concrete_Have_Field (F2)); + -- True if F1 appears in more concrete types than F2 + + function Sort_Less (F1, F2 : Field_Enum) return Boolean is + (if Num_Concrete_Have_Field (F1) = Num_Concrete_Have_Field (F2) then + F1 < F2 + else More_Types_Have_Field (F1, F2)); + + package Sorting is new Field_Vectors.Generic_Sorting + ("<" => Sort_Less); + + All_Fields : Field_Vector; + + begin + + -- Compute the number of types that have each field + + for T in Concrete_Type loop + for F in Field_Enum loop + if Fields_Per_Node (T) (F) then + Num_Concrete_Have_Field (F) := + Num_Concrete_Have_Field (F) + 1; + end if; + end loop; + end loop; + + -- Collect all the fields in All_Fields + + for F in Node_Field loop + Append (All_Fields, F); + end loop; + + for F in Entity_Field loop + Append (All_Fields, F); + end loop; + + -- Sort All_Fields based on how many concrete types have the field. + + Sorting.Sort (All_Fields); + + -- Go through all the fields, and choose the lowest offset that is + -- free in all types that have the field. + + for F of All_Fields loop + Field_Table (F).Offset := Choose_Offset (F); + end loop; + + end Compute_Field_Offsets; + + procedure Compute_Type_Sizes is + -- Node_Counts is the number of nodes of each kind created during + -- compilation of a large example. + + Node_Counts : constant array (Concrete_Node) of Natural := + (N_Identifier => 429298, + N_Defining_Identifier => 231636, + N_Integer_Literal => 90892, + N_Parameter_Specification => 62811, + N_Attribute_Reference => 47150, + N_Expanded_Name => 37375, + N_Selected_Component => 30699, + N_Subprogram_Declaration => 20744, + N_Freeze_Entity => 20314, + N_Procedure_Specification => 18901, + N_Object_Declaration => 18023, + N_Function_Specification => 16570, + N_Range => 16216, + N_Explicit_Dereference => 12198, + N_Component_Association => 11188, + N_Unchecked_Type_Conversion => 11165, + N_Subtype_Indication => 10727, + N_Procedure_Call_Statement => 10056, + N_Subtype_Declaration => 8141, + N_Handled_Sequence_Of_Statements => 8078, + N_Null => 7288, + N_Aggregate => 7222, + N_String_Literal => 7152, + N_Function_Call => 6958, + N_Simple_Return_Statement => 6911, + N_And_Then => 6867, + N_Op_Eq => 6845, + N_Call_Marker => 6683, + N_Pragma_Argument_Association => 6525, + N_Component_Definition => 6487, + N_Assignment_Statement => 6483, + N_With_Clause => 6480, + N_Null_Statement => 5917, + N_Index_Or_Discriminant_Constraint => 5877, + N_Generic_Association => 5667, + N_Full_Type_Declaration => 5573, + N_If_Statement => 5553, + N_Subprogram_Body => 5455, + N_Op_Add => 5443, + N_Type_Conversion => 5260, + N_Component_Declaration => 5059, + N_Raise_Constraint_Error => 4840, + N_Formal_Concrete_Subprogram_Declaration => 4602, + N_Expression_With_Actions => 4598, + N_Op_Ne => 3854, + N_Indexed_Component => 3834, + N_Op_Subtract => 3777, + N_Package_Specification => 3490, + N_Subprogram_Renaming_Declaration => 3445, + N_Pragma => 3427, + N_Case_Statement_Alternative => 3272, + N_Block_Statement => 3239, + N_Parameter_Association => 3213, + N_Op_Lt => 3020, + N_Op_Not => 2926, + N_Character_Literal => 2914, + N_Others_Choice => 2769, + N_Or_Else => 2576, + N_Itype_Reference => 2511, + N_Defining_Operator_Symbol => 2487, + N_Component_List => 2470, + N_Formal_Object_Declaration => 2262, + N_Generic_Subprogram_Declaration => 2227, + N_Real_Literal => 2156, + N_Op_Gt => 2156, + N_Access_To_Object_Definition => 1984, + N_Op_Le => 1975, + N_Op_Ge => 1942, + N_Package_Renaming_Declaration => 1811, + N_Formal_Type_Declaration => 1756, + N_Qualified_Expression => 1746, + N_Package_Declaration => 1729, + N_Record_Definition => 1651, + N_Allocator => 1521, + N_Op_Concat => 1377, + N_Access_Definition => 1358, + N_Case_Statement => 1322, + N_Number_Declaration => 1316, + N_Generic_Package_Declaration => 1311, + N_Slice => 1078, + N_Constrained_Array_Definition => 1068, + N_Exception_Renaming_Declaration => 1011, + N_Implicit_Label_Declaration => 978, + N_Exception_Handler => 966, + N_Private_Type_Declaration => 898, + N_Operator_Symbol => 872, + N_Formal_Private_Type_Definition => 867, + N_Range_Constraint => 849, + N_Aspect_Specification => 837, + N_Variant => 834, + N_Discriminant_Specification => 746, + N_Loop_Statement => 744, + N_Derived_Type_Definition => 731, + N_Freeze_Generic_Entity => 702, + N_Iteration_Scheme => 686, + N_Package_Instantiation => 658, + N_Loop_Parameter_Specification => 632, + N_Attribute_Definition_Clause => 608, + N_Compilation_Unit_Aux => 599, + N_Compilation_Unit => 599, + N_Label => 572, + N_Goto_Statement => 572, + N_In => 564, + N_Enumeration_Type_Definition => 523, + N_Object_Renaming_Declaration => 482, + N_If_Expression => 476, + N_Exception_Declaration => 472, + N_Reference => 455, + N_Incomplete_Type_Declaration => 438, + N_Use_Package_Clause => 401, + N_Unconstrained_Array_Definition => 360, + N_Variant_Part => 340, + N_Defining_Program_Unit_Name => 336, + N_Op_And => 334, + N_Raise_Program_Error => 329, + N_Formal_Discrete_Type_Definition => 319, + N_Contract => 311, + N_Not_In => 305, + N_Designator => 285, + N_Component_Clause => 247, + N_Formal_Signed_Integer_Type_Definition => 244, + N_Raise_Statement => 214, + N_Op_Expon => 205, + N_Op_Minus => 202, + N_Op_Multiply => 158, + N_Exit_Statement => 130, + N_Function_Instantiation => 129, + N_Discriminant_Association => 123, + N_Private_Extension_Declaration => 119, + N_Extended_Return_Statement => 117, + N_Op_Divide => 107, + N_Op_Or => 103, + N_Signed_Integer_Type_Definition => 101, + N_Record_Representation_Clause => 76, + N_Unchecked_Expression => 70, + N_Op_Abs => 63, + N_Elsif_Part => 62, + N_Formal_Floating_Point_Definition => 59, + N_Formal_Package_Declaration => 58, + N_Modular_Type_Definition => 55, + N_Abstract_Subprogram_Declaration => 52, + N_Validate_Unchecked_Conversion => 49, + N_Defining_Character_Literal => 36, + N_Raise_Storage_Error => 33, + N_Compound_Statement => 29, + N_Procedure_Instantiation => 28, + N_Access_Procedure_Definition => 25, + N_Floating_Point_Definition => 20, + N_Use_Type_Clause => 19, + N_Op_Plus => 14, + N_Package_Body => 13, + N_Op_Rem => 13, + N_Enumeration_Representation_Clause => 13, + N_Access_Function_Definition => 11, + N_Extension_Aggregate => 11, + N_Formal_Ordinary_Fixed_Point_Definition => 10, + N_Op_Mod => 10, + N_Expression_Function => 9, + N_Delay_Relative_Statement => 9, + N_Quantified_Expression => 7, + N_Formal_Derived_Type_Definition => 7, + N_Free_Statement => 7, + N_Iterator_Specification => 5, + N_Op_Shift_Left => 5, + N_Formal_Modular_Type_Definition => 4, + N_Generic_Package_Renaming_Declaration => 1, + N_Empty => 1, + N_Real_Range_Specification => 1, + N_Ordinary_Fixed_Point_Definition => 1, + N_Op_Shift_Right => 1, + N_Error => 1, + N_Mod_Clause => 1, + others => 0); + + Total_Node_Count : constant Long_Float := 1370676.0; + + type Node_Frequency_Table is array (Concrete_Node) of Long_Float; + + function Init_Node_Frequency return Node_Frequency_Table; + -- Compute the value of the Node_Frequency table + + function Average_Type_Size_In_Slots return Long_Float; + -- Compute the average over all concrete node types of the size, + -- weighted by the frequency of that node type. + + function Init_Node_Frequency return Node_Frequency_Table is + Result : Node_Frequency_Table := (others => 0.0); + + begin + for T in Concrete_Node loop + Result (T) := Long_Float (Node_Counts (T)) / Total_Node_Count; + end loop; + + return Result; + end Init_Node_Frequency; + + Node_Frequency : constant Node_Frequency_Table := Init_Node_Frequency; + -- Table mapping concrete node types to the relative frequency of + -- that node, in our large example. The sum of these values should + -- add up to approximately 1.0. For example, if Node_Frequency(K) = + -- 0.02, then that means that approximately 2% of all nodes are K + -- nodes. + + function Average_Type_Size_In_Slots return Long_Float is + -- We don't have data on entities, so we leave those out + + Result : Long_Float := 0.0; + begin + for T in Concrete_Node loop + Result := Result + + Node_Frequency (T) * Long_Float (Type_Size_In_Slots (T)); + end loop; + + return Result; + end Average_Type_Size_In_Slots; + + -- Start of processing for Compute_Type_Sizes + + begin + for T in Concrete_Type loop + declare + Max_Offset : Bit_Offset := 0; + + begin + for F in Field_Enum loop + if Fields_Per_Node (T) (F) then + Max_Offset := + Bit_Offset'Max + (Max_Offset, + To_Bit_Offset (F, Field_Table (F).Offset)); + end if; + end loop; + + Type_Bit_Size (T) := Max_Offset + 1; + end; + end loop; + + for T in Concrete_Node loop + Min_Node_Bit_Size := + Bit_Offset'Min (Min_Node_Bit_Size, Type_Bit_Size (T)); + Max_Node_Bit_Size := + Bit_Offset'Max (Max_Node_Bit_Size, Type_Bit_Size (T)); + end loop; + + for T in Concrete_Entity loop + Min_Entity_Bit_Size := + Bit_Offset'Min (Min_Entity_Bit_Size, Type_Bit_Size (T)); + Max_Entity_Bit_Size := + Bit_Offset'Max (Max_Entity_Bit_Size, Type_Bit_Size (T)); + end loop; + + Min_Node_Size := To_Size_In_Slots (Min_Node_Bit_Size); + Max_Node_Size := To_Size_In_Slots (Max_Node_Bit_Size); + Min_Entity_Size := To_Size_In_Slots (Min_Entity_Bit_Size); + Max_Entity_Size := To_Size_In_Slots (Max_Entity_Bit_Size); + + Average_Node_Size_In_Slots := Average_Type_Size_In_Slots; + end Compute_Type_Sizes; + + procedure Check_For_Syntactic_Mismatch is + begin + for F in Field_Enum loop + if F /= Between_Node_And_Entity_Fields then + declare + Syntactic_Seen, Semantic_Seen : Boolean := False; + Have_Field : Type_Vector renames + Field_Table (F).Have_This_Field; + + begin + for J in 1 .. Last_Index (Have_Field) loop + if Is_Syntactic (Have_Field (J)) (F) then + Syntactic_Seen := True; + else + Semantic_Seen := True; + end if; + end loop; + + -- The following fields violate this rule. We might want to + -- simplify by getting rid of these cases, but we allow them + -- for now. At least, we don't want to add any new cases of + -- syntactic/semantic mismatch. + + if F in Chars | Actions | Expression | Default_Expression + then + pragma Assert (Syntactic_Seen and Semantic_Seen); + + else + if Syntactic_Seen and Semantic_Seen then + raise Illegal with + "syntactic/semantic mismatch for " & Image (F); + end if; + + if Field_Table (F).Field_Type in Traversal_Type + and then Syntactic_Seen + then + Setter_Needs_Parent (F) := True; + end if; + end if; + end; + end if; + end loop; + end Check_For_Syntactic_Mismatch; + + function Field_Types_Used (First, Last : Field_Enum) return Type_Set is + Result : Type_Set := (others => False); + begin + for F in First .. Last loop + if Field_Table (F).Field_Type in Node_Or_Entity_Type then + Result (Node_Id) := True; + else + Result (Field_Table (F).Field_Type) := True; + end if; + end loop; + + return Result; + end Field_Types_Used; + + pragma Style_Checks ("M120"); + -- Lines of the form Put (S, "..."); are more readable if we relax the + -- line length. We really just want the "..." to be short enough. + + procedure Put_Type_And_Subtypes + (S : in out Sink'Class; Root : Root_Type) + is + + procedure Put_Enum_Type; + -- Print out the enumeration type declaration for a root type + -- (Node_Kind or Entity_Kind). + + procedure Put_Kind_Subtype (T : Node_Or_Entity_Type); + -- Print out a subrange (of type Node_Kind or Entity_Kind) for a + -- given nonroot abstract type. + + procedure Put_Id_Subtype (T : Node_Or_Entity_Type); + -- Print out a subtype (of type Node_Id or Entity_Id) for a given + -- nonroot abstract type. + + procedure Put_Enum_Type is + procedure Put_Enum_Lit (T : Node_Or_Entity_Type); + -- Print out one enumeration literal in the declaration of + -- Node_Kind or Entity_Kind. + + First_Time : Boolean := True; + + procedure Put_Enum_Lit (T : Node_Or_Entity_Type) is + begin + if T in Concrete_Type then + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1", Image (T)); + end if; + end Put_Enum_Lit; + + type Dummy is array + (First_Concrete (Root) .. Last_Concrete (Root)) of Boolean; + 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, "("); + 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); + end Put_Enum_Type; + + procedure Put_Kind_Subtype (T : Node_Or_Entity_Type) is + begin + if T in Abstract_Type then + 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_Images (S, Type_Table (T).Children); + Outdent (S, 2); + Put (S, ";\n"); + Outdent (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); + + 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))); + end loop; + + Outdent (S, 3); + end if; + end if; + end Put_Kind_Subtype; + + procedure Put_Id_Subtype (T : Node_Or_Entity_Type) is + begin + -- ????We have names like Overloadable_Kind_Id. + -- Perhaps that should be Overloadable_Id. + + 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)); + + 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); + end if; + + Put (S, ";\n"); + Outdent (S, 2); + end if; + end Put_Id_Subtype; + + begin -- Put_Type_And_Subtypes + Put_Enum_Type; + + -- Put the getter for Nkind and Ekind here, earlier than the other + -- getters, because it is needed in predicates of the following + -- subtypes. + + 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"); + + 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 Atree.\n\n"); + + when others => raise Program_Error; + end case; + + Put (S, "-- Subtypes of \1 for each abstract type:\n\n", + Image (Root)); + + Put (S, "pragma Style_Checks (""M200"");\n"); + 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"); + + Iterate_Types (Root, Pre => Put_Id_Subtype'Access); + Put (S, "\n"); + + Put (S, "-- Union types (nonhierarchical subtypes of \1)\n\n", + Id_Image (Root)); + + 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"); + end Put_Type_And_Subtypes; + + function Low_Level_Getter (T : Type_Enum) return String is + ("Get_" & Image (T)); + function Low_Level_Setter (T : Type_Enum) return String is + ("Set_" & Image (T)); + function Low_Level_Setter (F : Field_Enum) return String is + (Low_Level_Setter (Field_Table (F).Field_Type) & + (if Setter_Needs_Parent (F) then "_With_Parent" else "")); + + procedure Instantiate_Low_Level_Accessors + (S : in out Sink'Class; T : Type_Enum) + is + begin + -- Special case for types that have defaults; instantiate + -- Get_32_Bit_Field_With_Default and pass in the Default_Val. + + if T in Elist_Id | Uint then + pragma Assert (Field_Size (T) = 32); + + declare + Default_Val : constant String := + (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 (T), + Get_Set_Id_Image (T), + Default_Val, + Inline); + 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 (T), + Image (Field_Size (T)), + Get_Set_Id_Image (T), + Inline); + end if; + + -- No special case for the setter + + if T in Nkind_Type | Ekind_Type then + Put (S, "pragma Warnings (Off);\n"); + -- Set_Nkind_Type and Set_Ekind_Type might not be called + end if; + + Put (S, "procedure \1 is new Set_\2_Bit_Field (\3) with \4;\n", + Low_Level_Setter (T), + Image (Field_Size (T)), + Get_Set_Id_Image (T), + Inline); + + if T in Nkind_Type | Ekind_Type then + Put (S, "pragma Warnings (On);\n"); + end if; + end Instantiate_Low_Level_Accessors; + + procedure Put_Precondition + (S : in out Sink'Class; 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, + -- we don't need that, because we are fetching Ekind in that case, + -- which will assert N in N_Entity_Id. + + Is_Entity : constant String := + (if Field_Table (F).Have_This_Field = All_Entities then + "N in N_Entity_Id" + else ""); + begin + -- If this is an entity field, then we should assert that N is an + -- entity. We need "N in A | B | ..." unless this is embodied in a + -- subtype predicate. + -- + -- We can't put the extra "Pre => ..." specified on the call to + -- Create_..._Field as part of the precondition, because some of + -- them call things that are not visible here. + + if Enable_Assertions then + if Length (Field_Table (F).Have_This_Field) = 1 + 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); + end if; + + else + Put (S, ", Pre =>\n"); + Indent (S, 1); + Put (S, "N in "); + Put_Id_Images (S, Field_Table (F).Have_This_Field); + + pragma Assert (Is_Entity = ""); + + Outdent (S, 1); + end if; + end if; + end Put_Precondition; + + function Root_Type_For_Field (F : Field_Enum) return Root_Type is + (case F is + when Node_Field => Node_Kind, + when Entity_Field => Entity_Kind, + when Between_Node_And_Entity_Fields => Node_Kind); -- can't happen + + function N_Type (F : Field_Enum) return String is + (if Length (Field_Table (F).Have_This_Field) = 1 then + Id_Image (Field_Table (F).Have_This_Field (1)) + else Id_Image (Root_Type_For_Field (F))); + -- Name of the parameter type of the N parameter of the getter and + -- setter for field F. If there's only one Have_This_Field, use that; + -- the predicate will check for the right Kind. Otherwise, we use + -- Node_Id or Entity_Id, and the getter and setter will have + -- preconditions. + + function Node_To_Fetch_From (F : Field_Enum) return String is + begin + return + (case Field_Table (F).Type_Only is + when No_Type_Only => "N", + when Base_Type_Only => "Base_Type (N)", + when Impl_Base_Type_Only => "Implementation_Base_Type (N)", + when Root_Type_Only => "Root_Type (N)"); + end Node_To_Fetch_From; + + procedure Put_Getter_Spec (S : in out Sink'Class; 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); + end Put_Getter_Spec; + + procedure Put_Getter_Decl (S : in out Sink'Class; F : Field_Enum) is + begin + Put_Getter_Spec (S, F); + Put (S, " with \1", Inline); + Indent (S, 2); + Put_Precondition (S, F); + + Outdent (S, 2); + Put (S, ";\n"); + end Put_Getter_Decl; + + procedure Put_Getter_Body (S : in out Sink'Class; F : Field_Enum) is + begin + Put_Getter_Spec (S, F); + Put (S, " is\n"); + Put (S, "begin\n"); + Indent (S, 3); + + if Field_Table (F).Pre.all /= "" then + Put (S, "pragma Assert (\1);\n", Field_Table (F).Pre.all); + end if; + + Put (S, "return \1 (\2, \3);\n", + Low_Level_Getter (Field_Table (F).Field_Type), + Node_To_Fetch_From (F), + Image (Field_Table (F).Offset)); + Outdent (S, 3); + Put (S, "end \1;\n\n", Image (F)); + end Put_Getter_Body; + + procedure Put_Setter_Spec (S : in out Sink'Class; F : Field_Enum) is + Rec : Field_Info renames Field_Table (F).all; + Default : constant String := + (if Field_Table (F).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); + end Put_Setter_Spec; + + procedure Put_Setter_Decl (S : in out Sink'Class; F : Field_Enum) is + begin + Put_Setter_Spec (S, F); + Put (S, " with \1", Inline); + Indent (S, 2); + Put_Precondition (S, F); + Outdent (S, 2); + Put (S, ";\n"); + end Put_Setter_Decl; + + procedure Put_Setter_Body (S : in out Sink'Class; F : Field_Enum) is + -- If Type_Only was specified in the call to Create_Semantic_Field, + -- then we assert that the node is a base (etc) type. + + Type_Only_Assertion : constant String := + (case Field_Table (F).Type_Only is + when No_Type_Only => "", + when Base_Type_Only => "Is_Base_Type (N)", +-- ????It seems like we should call Is_Implementation_Base_Type or +-- Is_Root_Type (which don't currently exist), but the old version always +-- calls Base_Type. +-- when Impl_Base_Type_Only => "Is_Implementation_Base_Type (N)", +-- when Root_Type_Only => "Is_Root_Type (N)"); + when Impl_Base_Type_Only => "Is_Base_Type (N)", + when Root_Type_Only => "Is_Base_Type (N)"); + begin + Put_Setter_Spec (S, F); + Put (S, " is\n"); + Put (S, "begin\n"); + Indent (S, 3); + + if Field_Table (F).Pre.all /= "" then + Put (S, "pragma Assert (\1);\n", Field_Table (F).Pre.all); + end if; + + if Type_Only_Assertion /= "" then + Put (S, "pragma Assert (\1);\n", Type_Only_Assertion); + end if; + + Put (S, "\1 (N, \2, Val);\n", + Low_Level_Setter (F), + Image (Field_Table (F).Offset)); + Outdent (S, 3); + Put (S, "end Set_\1;\n\n", Image (F)); + end Put_Setter_Body; + + procedure Put_Subp_Decls (S : in out Sink'Class; 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"); + + 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"); + + elsif F = Ekind then + Put (S, "\n-- Ekind getter is above\n"); + + else + Put_Getter_Decl (S, F); + Put_Setter_Decl (S, F); + end if; + + Put (S, "\n"); + end loop; + end Put_Subp_Decls; + + procedure Put_Subp_Bodies (S : in out Sink'Class; Root : Root_Type) is + begin + Put (S, "\n-- Getters and setters for fields\n\n"); + + for F in First_Field (Root) .. Last_Field (Root) loop + Put_Getter_Body (S, F); + + if F not in Nkind | Ekind then + Put_Setter_Body (S, F); + end if; + end loop; + end Put_Subp_Bodies; + + procedure Put_Traversed_Fields (S : in out Sink'Class) is + + function Is_Traversed_Field + (T : Concrete_Node; F : Field_Enum) return Boolean; + -- True if F is a field that should be traversed by Traverse_Func. In + -- particular, True if F is a syntactic field of T, and is of a + -- Node_Id or List_Id type. + + function Init_Max_Traversed_Fields return Field_Offset; + -- Compute the maximum number of syntactic fields that are of type + -- Node_Id or List_Id over all node types. + + procedure Put_Agg (T : Node_Or_Entity_Type); + -- Print out the subaggregate for one type + + function Is_Traversed_Field + (T : Concrete_Node; F : Field_Enum) return Boolean is + begin + return Is_Syntactic (T) (F) + and then Field_Table (F).Field_Type in Traversal_Type; + end Is_Traversed_Field; + + First_Time : Boolean := True; + + procedure Put_Agg (T : Node_Or_Entity_Type) is + Left_Opnd_Skipped : Boolean := False; + begin + if T in Concrete_Node then + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1 => (", Image (T)); + Indent (S, 2); + + for FI in 1 .. Last_Index (Type_Table (T).Fields) loop + declare + F : constant Field_Enum := Type_Table (T).Fields (FI); + + begin + if Is_Traversed_Field (T, F) then + if F = Left_Opnd then + Left_Opnd_Skipped := True; -- see comment below + + else + Put (S, "\1, ", Image (Field_Table (F).Offset)); + end if; + end if; + end; + end loop; + + -- We always put the Left_Opnd field of N_Op_Concat last. See + -- comments in Atree.Traverse_Func for the reason. We might as + -- well do that for all Left_Opnd fields; the old version did + -- that. + + if Left_Opnd_Skipped then + Put (S, "\1, ", Image (Field_Table (Left_Opnd).Offset)); + end if; + + Put (S, "others => No_Field_Offset"); + + Outdent (S, 2); + Put (S, ")"); + end if; + end Put_Agg; + + function Init_Max_Traversed_Fields return Field_Offset is + Result : Field_Offset := 0; + begin + for T in Concrete_Node loop + declare + Num_Traversed_Fields : Field_Offset := 0; -- in type T + + begin + for FI in 1 .. Last_Index (Type_Table (T).Fields) loop + declare + F : constant Field_Enum := Type_Table (T).Fields (FI); + + begin + if Is_Traversed_Field (T, F) then + Num_Traversed_Fields := Num_Traversed_Fields + 1; + end if; + end; + end loop; + + if Num_Traversed_Fields > Result then + Result := Num_Traversed_Fields; + end if; + end; + end loop; + + return Result; + end Init_Max_Traversed_Fields; + + Max_Traversed_Fields : constant Field_Offset := + 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, "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"); + -- One extra for the sentinel + + Indent (S, 2); + Put (S, "("); + Indent (S, 1); + Iterate_Types (Node_Kind, Pre => Put_Agg'Access); + Outdent (S, 1); + Put (S, ");\n\n"); + Outdent (S, 2); + end Put_Traversed_Fields; + + procedure Put_Tables (S : in out Sink'Class; Root : Root_Type) is + + First_Time : Boolean := True; + + procedure Put_Size (T : Node_Or_Entity_Type); + procedure Put_Size (T : Node_Or_Entity_Type) is + begin + if T in Concrete_Type then + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1 => \2", Image (T), Image (Type_Size_In_Slots (T))); + end if; + end Put_Size; + + procedure Put_Field_Array (T : Concrete_Type); + + procedure Put_Field_Array (T : Concrete_Type) is + First_Time : Boolean := True; + begin + for F in First_Field (Root) .. Last_Field (Root) loop + if Fields_Per_Node (T) (F) then + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1", Image (F)); + end if; + end loop; + end Put_Field_Array; + + Field_Enum_Type_Name : constant String := + (case Root is + when Node_Kind => "Node_Field", + 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)); + + 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); + 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)); + when others => raise Program_Error; + end case; + + Put (S, "Size : constant array (\1) of Field_Offset :=\n", Image (Root)); + Indent (S, 2); + Put (S, "("); + Indent (S, 1); + + Iterate_Types (Root, Pre => Put_Size'Access); + + Outdent (S, 1); + Put (S, "); -- Size\n"); + Outdent (S, 2); + + declare + type Dummy is array + (First_Field (Root) .. Last_Field (Root)) of Boolean; + 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, "type \1 is\n", Field_Enum_Type_Name); + Indent (S, 2); + Put (S, "("); + Indent (S, 1); + + for F in First_Field (Root) .. Last_Field (Root) loop + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1", Image (F)); + end loop; + + Outdent (S, 1); + Put (S, "); -- \1\n", Field_Enum_Type_Name); + Outdent (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); + -- Short name to make allocators below more readable + + declare + First_Time : Boolean := True; + + procedure Do_One_Type (T : Node_Or_Entity_Type); + procedure Do_One_Type (T : Node_Or_Entity_Type) is + begin + if T in Concrete_Type then + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1 =>\n", Image (T)); + Indent (S, 2); + Put (S, "new A'("); + Indent (S, 6); + Indent (S, 1); + + Put_Field_Array (T); + + Outdent (S, 1); + Put (S, ")"); + Outdent (S, 6); + Outdent (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, "\1_Table : constant array (\2) of \1_Array_Ref :=\n", + Field_Enum_Type_Name, Image (Root)); + + Indent (S, 2); + Put (S, "("); + 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); + end; + + declare + First_Time : Boolean := True; + begin + Put (S, "\n-- Table mapping fields to kind and offset:\n\n"); + + Put (S, "\1_Descriptors : constant array (\1) of Field_Descriptor :=\n", + Field_Enum_Type_Name); + + Indent (S, 2); + Put (S, "("); + Indent (S, 1); + + for F in First_Field (Root) .. Last_Field (Root) loop + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1 => (\2_Field, \3)", Image (F), + Image (Field_Table (F).Field_Type), Image (Field_Table (F).Offset)); + end loop; + + Outdent (S, 1); + Put (S, "); -- Field_Descriptors\n"); + Outdent (S, 2); + end; + + end Put_Tables; + + procedure Put_Seinfo is + S : Sink'Class := Create_File ("seinfo.ads"); + begin + Put (S, "with Types; use Types;\n"); + Put (S, "\npackage Seinfo is\n\n"); + Indent (S, 3); + + Put (S, "-- This package is automatically generated.\n\n"); + + Put (S, "-- Common declarations visible in both Sinfo.Nodes and Einfo.Entities.\n"); + + Put (S, "\ntype Field_Kind is\n"); + Indent (S, 2); + Put (S, "("); + Indent (S, 1); + + declare + First_Time : Boolean := True; + begin + for T in Special_Type loop + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1_Field", Image (T)); + end loop; + end; + + Outdent (S, 1); + Outdent (S, 2); + Put (S, ");\n"); + + Put (S, "\nField_Size : constant array (Field_Kind) of Field_Size_In_Bits :=\n"); + Indent (S, 2); + Put (S, "("); + Indent (S, 1); + + declare + First_Time : Boolean := True; + begin + for T in Special_Type loop + if First_Time then + First_Time := False; + else + Put (S, ",\n"); + end if; + + Put (S, "\1_Field => \2", Image (T), Image (Field_Size (T))); + end loop; + end; + + Outdent (S, 1); + Outdent (S, 2); + Put (S, ");\n\n"); + + 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"); + + Outdent (S, 3); + Put (S, "\nend Seinfo;\n"); + end Put_Seinfo; + + procedure Put_Nodes is + S : Sink'Class := Create_File ("sinfo-nodes.ads"); + B : Sink'Class := Create_File ("sinfo-nodes.adb"); + + procedure Put_Setter_With_Parent (Kind : String); + -- Put the low-level ..._With_Parent setter. Kind is either "Node" or + -- "List". + + 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); + end Put_Setter_With_Parent; + + begin + Put (S, "with Seinfo; use Seinfo;\n"); + Put (S, "pragma Warnings (Off); -- ????\n"); + Put (S, "with Output; use Output;\n"); + Put (S, "pragma Warnings (On); -- ????\n"); + + Put (S, "\npackage Sinfo.Nodes is\n\n"); + Indent (S, 3); + + Put (S, "-- This package is automatically generated.\n\n"); + + 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_Subp_Decls (S, Node_Kind); + + Put_Traversed_Fields (S); + + Put_Tables (S, Node_Kind); + + Outdent (S, 3); + Put (S, "\nend Sinfo.Nodes;\n"); + + Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;\n"); + Put (B, "with Nlists; use Nlists;\n"); + + Put (B, "\npackage body Sinfo.Nodes is\n\n"); + Indent (B, 3); + + Put (B, "-- This package is automatically generated.\n\n"); + + 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, "pragma Style_Checks (""M200"");\n"); + for T in Special_Type loop + if Node_Field_Types_Used (T) then + Instantiate_Low_Level_Accessors (B, T); + end if; + end loop; + + Put_Setter_With_Parent ("Node"); + Put_Setter_With_Parent ("List"); + + Put_Subp_Bodies (B, Node_Kind); + + Outdent (B, 3); + Put (B, "end Sinfo.Nodes;\n"); + + end Put_Nodes; + + procedure Put_Entities is + S : Sink'Class := Create_File ("einfo-entities.ads"); + B : Sink'Class := Create_File ("einfo-entities.adb"); + begin + Put (S, "with Seinfo; use Seinfo;\n"); + Put (S, "pragma Warnings (Off); -- ????\n"); + Put (S, "with Output; use Output;\n"); + Put (S, "with Sinfo.Nodes; use Sinfo.Nodes;\n"); + Put (S, "pragma Warnings (On); -- ????\n"); + + Put (S, "\npackage Einfo.Entities is\n\n"); + Indent (S, 3); + + Put (S, "-- This package is automatically generated.\n\n"); + + Put_Type_Hierarchy (S, Entity_Kind); + + Put_Type_And_Subtypes (S, Entity_Kind); + + Put_Subp_Decls (S, Entity_Kind); + + Put_Tables (S, Entity_Kind); + + Outdent (S, 3); + Put (S, "\nend Einfo.Entities;\n"); + + Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;\n"); + Put (B, "with Einfo.Utils; use Einfo.Utils;\n"); + -- 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, "-- This package is automatically generated.\n\n"); + + 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, "pragma Style_Checks (""M200"");\n"); + for T in Special_Type loop + if Entity_Field_Types_Used (T) then + Instantiate_Low_Level_Accessors (B, T); + end if; + end loop; + + Put_Subp_Bodies (B, Entity_Kind); + + Outdent (B, 3); + Put (B, "end Einfo.Entities;\n"); + + end Put_Entities; + + procedure Put_Make_Spec + (S : in out Sink'Class; Root : Root_Type; T : Concrete_Type) + is + begin + Put (S, "function Make_\1 (Sloc : Source_Ptr", Image_Sans_N (T)); + Indent (S, 3); + + for F of Type_Table (T).Fields loop + pragma Assert (Fields_Per_Node (T) (F)); + + if Is_Syntactic (T) (F) then + declare + Typ : constant String := + (if Field_Table (F).Field_Type = Flag then "Boolean" + else Image (Field_Table (F).Field_Type)); + + -- All Flag fields have a default, which is False by + -- default. + + Default : constant String := + (if Field_Table (F).Default_Value = No_Default then + (if Field_Table (F).Field_Type = Flag then " := False" else "") + else " := " & Value_Image (Field_Table (F).Default_Value)); + + Suppress_Default : constant Boolean := False; + -- ????For testing. Strip out the defaults from the old + -- nmake.ads. Set this to True, and generate the new + -- nmake.ads. Then diff the two. Same for nmake.adb. + -- They should be identical, except for minor diffs like + -- comments. + + begin + Put (S, ";\n"); + + Put (S, "\1", Image (F)); + Tab_To_Column (S, 36); + Put (S, " : \1\2", + Typ, + (if Suppress_Default then "" else Default)); + end; + end if; + end loop; + + Put (S, ")\nreturn \1_Id", Node_Or_Entity (Root)); + Outdent (S, 3); + end Put_Make_Spec; + + procedure Put_Make_Decls (S : in out Sink'Class; Root : Root_Type) is + begin + -- The order of the functions doesn't matter, but we're using + -- Sinfo_Node_Order here so we can diff the nmake code against the + -- old version. That means this code won't work for entities. + -- There was no Emake for entities, but it might be nice to + -- have someday. If we want that, we should say: + -- + -- for T in First_Concrete (Root) .. Last_Concrete (Root) loop + -- + -- We would need to decide which fields to include as parameters, + -- because there are no syntactic fields of entities. + + for T of Sinfo_Node_Order loop + Put_Make_Spec (S, Root, T); + Put (S, ";\npragma \1 (Make_\2);\n\n", Inline, Image_Sans_N (T)); + end loop; + end Put_Make_Decls; + + procedure Put_Make_Bodies (S : in out Sink'Class; Root : Root_Type) is + begin + for T of Sinfo_Node_Order loop + Put_Make_Spec (S, Root, T); + Put (S, "\nis\n"); + + Indent (S, 3); + Put (S, "N : constant Node_Id :=\n"); + + if T in Entity_Node then + Put (S, " New_Entity (\1, Sloc);\n", Image (T)); + + else + Put (S, " New_Node (\1, Sloc);\n", Image (T)); + end if; + + Outdent (S, 3); + + Put (S, "begin\n"); + + Indent (S, 3); + for F of Type_Table (T).Fields loop + pragma Assert (Fields_Per_Node (T) (F)); + + if Is_Syntactic (T) (F) then + declare + NWidth : constant := 28; + -- This constant comes from the old Xnmake, which wraps + -- the Set_... call if the field name is that long or + -- longer. + + F_Name : constant String := Image (F); + + begin + if F_Name'Length < NWidth then + Put (S, "Set_\1 (N, \1);\n", F_Name); + + -- Wrap the line + + else + Put (S, "Set_\1\n", F_Name); + Indent (S, 2); + Put (S, "(N, \1);\n", F_Name); + Outdent (S, 2); + end if; + end; + end if; + end loop; + + if Is_Descendant (N_Op, T) then + -- Special cases for N_Op nodes: fill in the Chars and Entity + -- fields even though they were not passed in. + + declare + Op : constant String := Image_Sans_N (T); + -- This will be something like "Op_And" or "Op_Add" + + Op_Name_With_Op : constant String := + (if T = N_Op_Plus then "Op_Add" + elsif T = N_Op_Minus then "Op_Subtract" + else Op); + -- Special cases for unary operators that have the same name + -- as a binary operator; we use the binary operator name in + -- that case. + + Slid : constant String (1 .. Op_Name_With_Op'Length) := + Op_Name_With_Op; + pragma Assert (Slid (1 .. 3) = "Op_"); + + Op_Name : constant String := + (if T in N_Op_Rotate_Left | + N_Op_Rotate_Right | + N_Op_Shift_Left | + N_Op_Shift_Right | + N_Op_Shift_Right_Arithmetic + then Slid (4 .. Slid'Last) + else Slid); + -- Special cases for shifts and rotates; the node kind has + -- "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); + end; + end if; + + Put (S, "return N;\n"); + Outdent (S, 3); + + Put (S, "end Make_\1;\n\n", Image_Sans_N (T)); + end loop; + end Put_Make_Bodies; + + -- Documentation for the Nmake package, generated by Put_Nmake below. + + -- The Nmake package contains a set of routines used to construct tree + -- nodes using a functional style. There is one routine for each node + -- type defined in Gen_IL.Gen.Gen_Nodes with the general interface: + + -- function Make_xxx (Sloc : Source_Ptr, + -- Field_Name_1 : Field_Name_1_Type [:= default] + -- Field_Name_2 : Field_Name_2_Type [:= default] + -- ...) + -- return Node_Id + + -- Only syntactic fields are included. + + -- Default values are provided as specified in Gen_Nodes, except that if + -- no default is specified for a flag field, it has a default of False. + + -- Warning: since calls to Make_xxx routines are normal function calls, the + -- arguments can be evaluated in any order. This means that at most one such + -- 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"); + + 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"); + + Put (S, "\npackage Nmake is\n\n"); + 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, "pragma Style_Checks (""M200"");\n"); + -- ????Work around bug in a-stouut.adb. + + Put_Make_Decls (S, Node_Kind); + + Outdent (S, 3); + Put (S, "end Nmake;\n"); + + 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, "\npackage body Nmake is\n\n"); + Indent (B, 3); + + Put (B, "-- This package is automatically generated.\n\n"); +-- Put (B, "pragma Style_Checks (""M200"");\n"); + -- ????Work around bug in a-stouut.adb. + + Put_Make_Bodies (B, Node_Kind); + + Outdent (B, 3); + Put (B, "end Nmake;\n"); + end Put_Nmake; + + procedure Put_Seinfo_Tables is + S : Sink'Class := Create_File ("seinfo_tables.ads"); + B : Sink'Class := Create_File ("seinfo_tables.adb"); + + Type_Layout : Type_Layout_Array; + + function Get_Last_Bit + (T : Concrete_Type; F : Opt_Field_Enum; First_Bit : Bit_Offset) + return Bit_Offset; + function First_Bit_Image (First_Bit : Bit_Offset) return String; + function Last_Bit_Image (Last_Bit : Bit_Offset) return String; + + procedure Put_Field_List (Bit : Bit_Offset); + -- Print out the list of fields that are allocated (in part, for + -- fields bigger than one bit) at the given bit offset. This allows + -- us to see which fields are overlaid with each other, which should + -- only happen if the sets of types with those fields are disjoint. + + function Get_Last_Bit + (T : Concrete_Type; F : Opt_Field_Enum; First_Bit : Bit_Offset) + return Bit_Offset is + begin + return Result : Bit_Offset do + if F = No_Field then + -- We don't have a field size for No_Field, so just look at + -- the bits up to the next word boundary. + + Result := First_Bit; + + while (Result + 1) mod 32 /= 0 + and then Type_Layout (T) (Result + 1) = No_Field + loop + Result := Result + 1; + end loop; + + else + Result := First_Bit + Field_Size (F) - 1; + end if; + end return; + end Get_Last_Bit; + + function First_Bit_Image (First_Bit : Bit_Offset) return String is + W : constant Bit_Offset := First_Bit / 32; + B : constant Bit_Offset := First_Bit mod 32; + pragma Assert (W * 32 + B = First_Bit); + begin + return + Image (W) & "*32" & (if B = 0 then "" else " + " & Image (B)); + end First_Bit_Image; + + function Last_Bit_Image (Last_Bit : Bit_Offset) return String is + W : constant Bit_Offset := (Last_Bit + 1) / 32; + begin + if W * 32 - 1 = Last_Bit then + return Image (W) & "*32 - 1"; + else + return First_Bit_Image (Last_Bit); + end if; + end Last_Bit_Image; + + function Image_Or_Waste (F : Opt_Field_Enum) return String is + (if F = No_Field then "Wasted_Bits" else Image (F)); + + Num_Wasted_Bits : Bit_Offset'Base := 0; + + Type_Layout_Size : Bit_Offset'Base := Type_Layout'Size; + -- Total size of Type_Layout, including the Field_Arrays its + -- components point to. + + procedure Put_Field_List (Bit : Bit_Offset) is + First_Time : Boolean := True; + begin + for F in Field_Enum loop + if F /= Between_Node_And_Entity_Fields + and then Bit in First_Bit (F, Field_Table (F).Offset) + .. Last_Bit (F, Field_Table (F).Offset) + then + if First_Time then + First_Time := False; + else + Put (B, ",\n"); + end if; + + Put (B, "\1", Image (F)); + end if; + end loop; + end Put_Field_List; + + begin -- Put_Seinfo_Tables + + for T in Concrete_Type loop + Type_Layout (T) := new Field_Array' + (0 .. Type_Bit_Size_Aligned (T) - 1 => No_Field); + Type_Layout_Size := Type_Layout_Size + Type_Layout (T).all'Size; + + for F in Field_Enum loop + if Fields_Per_Node (T) (F) then + declare + Off : constant Field_Offset := Field_Table (F).Offset; + subtype Bit_Range is Bit_Offset + range First_Bit (F, Off) .. Last_Bit (F, Off); + begin + pragma Assert + (Type_Layout (T) (Bit_Range) = (Bit_Range => No_Field)); + Type_Layout (T) (Bit_Range) := (others => F); + end; + end if; + end loop; + end loop; + + for T in Concrete_Type loop + for B in 0 .. Type_Bit_Size_Aligned (T) - 1 loop + if Type_Layout (T) (B) = No_Field then + Num_Wasted_Bits := Num_Wasted_Bits + 1; + end if; + end loop; + end loop; + + Put (S, "\npackage Seinfo_Tables is\n\n"); + Indent (S, 3); + + Put (S, "-- This package is automatically generated.\n\n"); + + 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, "pragma Elaborate_Body;\n"); + + Outdent (S, 3); + Put (S, "\nend Seinfo_Tables;\n"); + + 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.Utils; use Gen_IL.Utils;\n"); + + Put (B, "\npackage body Seinfo_Tables is\n\n"); + Indent (B, 3); + + Put (B, "-- This package is automatically generated.\n\n"); + + Put (B, "Num_Wasted_Bits : Bit_Offset'Base := \1 with Unreferenced;\n", + Image (Num_Wasted_Bits)); + + Put (B, "\nWasted_Bits : constant Opt_Field_Enum := No_Field;\n"); + + 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, "-- 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, "\n-- Type_Layout is \1 bytes.\n", Image (Type_Layout_Size / 8)); + + Put (B, "\npragma Style_Checks (Off);\n"); + Put (B, "Type_Layout : constant Type_Layout_Array := \n"); + Indent (B, 2); + Put (B, "-- Concrete node types:\n"); + Put (B, "("); + Indent (B, 1); + + declare + First_Time : Boolean := True; + begin + for T in Concrete_Type loop + if First_Time then + First_Time := False; + else + Put (B, ",\n\n"); + end if; + + if T = Concrete_Entity'First then + Put (B, "-- Concrete entity types:\n\n"); + end if; + + Put (B, "\1 => new Field_Array'\n", Image (T)); + + Indent (B, 2); + Put (B, "("); + Indent (B, 1); + + declare + First_Time : Boolean := True; + First_Bit : Bit_Offset := 0; + begin + while First_Bit < Type_Bit_Size_Aligned (T) loop + if First_Time then + First_Time := False; + else + Put (B, ",\n"); + end if; + + declare + F : constant Opt_Field_Enum := + Type_Layout (T) (First_Bit); + begin + declare + Last_Bit : constant Bit_Offset := + Get_Last_Bit (T, F, First_Bit); + begin + pragma Assert + (Type_Layout (T) (First_Bit .. Last_Bit) = + (First_Bit .. Last_Bit => F)); + + if Last_Bit = First_Bit then + Put (B, "\1 => \2", + 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), + Image_Or_Waste (F)); + end if; + + First_Bit := Last_Bit + 1; + end; + end; + end loop; + end; + + Outdent (B, 1); + Put (B, ")"); + Outdent (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); + + 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"); + + Indent (B, 2); + Put (B, "("); + Indent (B, 1); + + declare + First_Time : Boolean := True; + begin + for Bit in 0 .. Bit_Offset'Max + (Max_Node_Bit_Size, Max_Entity_Bit_Size) + loop + if First_Time then + First_Time := False; + else + Put (B, ",\n\n"); + end if; + + Put (B, "\1 => new Field_Array'\n", First_Bit_Image (Bit)); + + -- 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); + Put (B, "["); + Indent (B, 1); + + Put_Field_List (Bit); + + Outdent (B, 1); + Put (B, "]"); + Outdent (B, 2); + end loop; + end; + + Outdent (B, 1); + Put (B, "); -- Bit_Used\n"); + Outdent (B, 2); + + Outdent (B, 3); + Put (B, "\nend Seinfo_Tables;\n"); + + end Put_Seinfo_Tables; + + procedure Put_C_Type_And_Subtypes + (S : in out Sink'Class; Root : Root_Type) is + + procedure Put_Enum_Lit (T : Node_Or_Entity_Type); + -- Print out the #define corresponding to the Ada enumeration literal + -- for T in Node_Kind and Entity_Kind (i.e. concrete types). + + procedure Put_Kind_Subtype (T : Node_Or_Entity_Type); + -- Print out the SUBTYPE macro call corresponding to an abstract + -- type. + + 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))); + 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); + 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)); + + 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; + + procedure Put_Low_Level_C_Getter + (S : in out Sink'Class; 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)); + + Indent (S, 3); + + -- Same special case as in Instantiate_Low_Level_Accessors + + if T in Elist_Id | Uint then + pragma Assert (Field_Size (T) = 32); + + declare + Default_Val : constant String := + (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); + end; + + else + Put (S, "{ return (\1) Get_\2_Bit_Field(N, Offset); }\n\n", + T_Image, Image (Field_Size (T))); + end if; + + Outdent (S, 3); + end Put_Low_Level_C_Getter; + + procedure Put_High_Level_C_Getter + (S : in out Sink'Class; 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 (Field_Table (F).Field_Type), + Node_To_Fetch_From (F), + Image (Field_Table (F).Offset)); + Outdent (S, 3); + end Put_High_Level_C_Getter; + + procedure Put_High_Level_C_Getters + (S : in out Sink'Class; Root : Root_Type) + is + begin + Put (S, "// Getters for fields\n\n"); + + for F in First_Field (Root) .. Last_Field (Root) loop + Put_High_Level_C_Getter (S, F); + end loop; + end Put_High_Level_C_Getters; + + procedure Put_Union_Membership + (S : in out Sink'Class; Root : Root_Type) is + + procedure Put_Ors (T : Abstract_Type); + -- Print the "or" (i.e. "||") of tests whether kind is in each child + -- type. + + procedure Put_Ors (T : Abstract_Type) is + First_Time : Boolean := True; + begin + for Child of Type_Table (T).Children loop + if First_Time then + First_Time := False; + else + Put (S, " ||\n"); + end if; + + -- Unions, other abstract types, and concrete types each have + -- their own way of testing membership in the C++ code. + + if Child in Abstract_Type then + if Type_Table (Child).Is_Union then + Put (S, "Is_In_\1 (kind)", Image (Child)); + + else + Put (S, "IN (kind, \1)", Image (Child)); + end if; + + else + Put (S, "kind == \1", Image (Child)); + end if; + end loop; + end Put_Ors; + + begin + Put (S, "\n// Membership tests for union types\n\n"); + + 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_Ors (T); + Outdent (S, 3); + Outdent (S, 3); + Put (S, ";\n}\n"); + + Put (S, "\n"); + end if; + end loop; + end Put_Union_Membership; + + procedure Put_Sinfo_Dot_H is + S : Sink'Class := Create_File ("sinfo.h"); + + begin + Put (S, "#ifdef __cplusplus\n"); + Put (S, "extern ""C"" {\n"); + Put (S, "#endif\n\n"); + + Put (S, "typedef Boolean Flag;\n\n"); + + 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"); + + for T in Special_Type loop + Put_Low_Level_C_Getter (S, T); + end loop; + + Put_High_Level_C_Getters (S, Node_Kind); + + Put (S, "#ifdef __cplusplus\n"); + Put (S, "}\n"); + Put (S, "#endif\n"); + end Put_Sinfo_Dot_H; + + procedure Put_Einfo_Dot_H is + S : Sink'Class := Create_File ("einfo.h"); + + 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. + + procedure Put_Membership_Query_Spec (T : Node_Or_Entity_Type) is + Im : constant String := Image (T); + pragma Assert (Im (Im'Last - 4 .. Im'Last) = "_Kind"); + Im2 : constant String := Im (Im'First .. Im'Last - 5); + Typ : constant String := + (if Is_Descendant (Type_Kind, T) + and then T /= Type_Kind + then "_Type" + else ""); + 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)"); + 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); + end if; + end Put_Membership_Query_Defn; + + begin + Put (S, "#ifdef __cplusplus\n"); + Put (S, "extern ""C"" {\n"); + Put (S, "#endif\n\n"); + + Put (S, "typedef Boolean Flag;\n\n"); + + 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"); + + 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"); + end Put_Einfo_Dot_H; + + begin -- Compile + + Check_Completeness; + + Compute_Ranges (Node_Kind); + Compute_Ranges (Entity_Kind); + Compute_Fields_Per_Node; + Compute_Field_Offsets; + Compute_Type_Sizes; + Check_For_Syntactic_Mismatch; + + Verify_Type_Table; + + Node_Field_Types_Used := + Field_Types_Used (Node_Field'First, Node_Field'Last); + Entity_Field_Types_Used := + Field_Types_Used (Entity_Field'First, Entity_Field'Last); + + Put_Seinfo; + + Put_Nodes; + + Put_Entities; + + Put_Nmake; + + Put_Seinfo_Tables; + + Put_Sinfo_Dot_H; + Put_Einfo_Dot_H; + + end Compile; + + function Sy + (Field : Node_Field; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value := No_Default; + Pre : String := "") return Field_Sequence is + begin + return + (1 => Create_Syntactic_Field (Field, Field_Type, Default_Value, Pre)); + end Sy; + + function Sm + (Field : Field_Enum; + Field_Type : Type_Enum; + Type_Only : Type_Only_Enum := No_Type_Only; + Pre : String := "") return Field_Sequence is + begin + return (1 => Create_Semantic_Field (Field, Field_Type, Type_Only, Pre)); + end Sm; + +end Gen_IL.Gen; diff --git a/gcc/ada/gen_il-gen.ads b/gcc/ada/gen_il-gen.ads new file mode 100644 index 00000000000..13f8c598413 --- /dev/null +++ b/gcc/ada/gen_il-gen.ads @@ -0,0 +1,220 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . G E N -- +-- -- +-- 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. 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 Gen_IL.Types; use Gen_IL.Types; +pragma Warnings (Off); +with Gen_IL.Fields; use Gen_IL.Fields; -- for children +pragma Warnings (On); +with Gen_IL.Utils; use Gen_IL.Utils; +use Gen_IL.Utils.Type_Vectors; +use Gen_IL.Utils.Field_Vectors; + +package Gen_IL.Gen is + + -- "Language design is library design and library design is language + -- design". + -- -- Bjarne Stroustrup + + -- This package provides a "little language" for defining type hierarchies, + -- which we call "Gen_IL.Gen". In particular, it is used to describe the + -- type hierarchies rooted at Node_Id and Entity_Id in the intermediate + -- language used by GNAT. + + -- The type hierarchy is a strict hierarchy (treeish, no multiple + -- inheritance). We have "abstract" and "concrete" types. Each type has a + -- "parent", except for the root type (Node_Id or Entity_Id). All leaf + -- types in the hierarchy are concrete; all nonleaf types (including the + -- two root types) are abstract. One can create instances of concrete, but + -- not abstract, types. + -- + -- Descendants of Node_Id/Node_Kind are node types, and descendants of + -- Entity_Id/Entity_Kind are entity types. + -- + -- Types have "fields". Each type inherits all the fields from its parent, + -- and may add new ones. A node field can be marked "syntactic"; entity + -- fields are never syntactic. A nonsyntactic field is "semantic". + -- + -- If a field is syntactic, then the constructors in Nmake take a parameter + -- to initialize that field. In addition, the tree-traversal routines in + -- Atree (Traverse_Func and Traverse_Proc) traverse syntactic fields that + -- are of type Node_Id (or subtypes of Node_Id) or List_Id. Finally, (with + -- some exceptions documented in the body) the setter for a syntactic node + -- or list field "Set_F (N, Val)" will set the Parent of Val to N, unless + -- Val is Empty or Error[_List]. + -- + -- Note that the same field can be syntactic in some node types but + -- semantic in other node types. This is an added complexity that we might + -- want to eliminate someday. We shouldn't add any new such cases. + -- + -- A "program" written in the Gen_IL.Gen language consists of calls to the + -- "Create_..." routines below, followed by a call to Compile, also below. + -- In order to understand what's going on, you need to look not only at the + -- Gen_IL.Gen "code", but at the output of the compiler -- at least, look + -- at the specs of Sinfo.Nodes and Einfo.Entities, because GNAT invokes + -- those directly. It's not like a normal language where you don't usually + -- have to look at the generated machine code. + -- + -- Thus, the Gen_IL.Gen code is really Ada code, and when you run it as an + -- Ada program, it generates the above-mentioned files. The program is + -- somewhat unusual in that it has no input. Everything it needs to + -- generate code is embodied in it. + + -- Why don't we just use a variant record, instead of inventing a wheel? + -- Or a hierarchy of tagged types? + -- + -- The key feature that Ada's variant records and tagged types lack, and + -- that this little language has, is that if two types have a field with + -- the same name, then those are the same field, even though they weren't + -- inherited from a common ancestor. Such fields are required to have the + -- same type, the same default value, and the same extra precondition. + + procedure Create_Root_Node_Type + (T : Abstract_Node; + Fields : Field_Sequence := No_Fields) + with Pre => T = Node_Kind; + procedure Create_Abstract_Node_Type + (T : Abstract_Node; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields); + procedure Create_Concrete_Node_Type + (T : Concrete_Node; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields); + procedure Create_Root_Entity_Type + (T : Abstract_Entity; + Fields : Field_Sequence := No_Fields) + with Pre => T = Entity_Kind; + procedure Create_Abstract_Entity_Type + (T : Abstract_Entity; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields); + procedure Create_Concrete_Entity_Type + (T : Concrete_Entity; Parent : Abstract_Type; + Fields : Field_Sequence := No_Fields); + + function Create_Syntactic_Field + (Field : Node_Field; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value := No_Default; + Pre : String := "") return Field_Desc; + function Create_Semantic_Field + (Field : Field_Enum; + Field_Type : Type_Enum; + Type_Only : Type_Only_Enum := No_Type_Only; + Pre : String := "") return Field_Desc; + -- Create_Syntactic_Field is used for syntactic fields of nodes. The order + -- of calls to Create_Syntactic_Field determines the order of the formal + -- parameters of the Make_... functions in Nmake. + -- + -- Create_Semantic_Field is used for semantic fields of nodes, and all + -- fields of entities are considered semantic. The order of calls doesn't + -- make any difference. + -- + -- Field_Type is the type of the field. Default_Value is the default value + -- for the parameter of the Make_... function in Nmake; this is effective + -- only for syntactic fields. Flag fields of syntactic nodes always have a + -- default value, which is False unless specified as Default_True. Pre is + -- an additional precondition for the field getter and setter, in addition + -- to the precondition that asserts that the type has that field. + -- + -- If multiple calls to these occur for the same Field but different types, + -- the Field_Type and Pre must match. Default_Value should match for + -- syntactic fields. See the declaration of Type_Only_Enum for Type_Only. + -- + -- (The matching Default_Value requirement is a simplification from the + -- earlier hand-written version.) + + -- To add a new node or entity type, add it to the enumeration type in + -- Gen_IL.Types, taking care that it is in the approprate range + -- (Abstract_Node, Abstract_Entity, Concrete_Node, or Concrete_Entity). + -- Then add a call to one of the above type-creation procedures to + -- Sinfo.Nodes or Einfo.Entities. + -- + -- To add a new field to a type, add a call to one of the above field + -- creation procedures to Sinfo.Nodes or Einfo.Entities. + + -- Forward references are not allowed. So if you say: + -- + -- Create..._Type (..., Parent => P); + -- + -- then Create..._Type must have already been called to create P. + -- + -- Likewise, if you say: + -- + -- Create..._Field (T, F, Field_Type, ...); + -- + -- then Create..._Type must have already been called to create T and + -- (if it's a node or entity type) to create Field_Type. + -- + -- To delete a node or entity type, delete it from Gen_IL.Types, update the + -- subranges in Gen_IL.Utils if necessary, and delete all occurrences from + -- Gen_IL.Gen.Gen_Entities. To delete a field, delete it from + -- Gen_IL.Fields, and delete all occurrences from Gen_IL.Gen.Gen_Entities. + + -- If a field is not set, it is initialized by default to whatever value is + -- represented by all-zero bits, with two exceptions: Elist fields default + -- to No_Elist, and Uint fields default to Uint_0. In retrospect, it would + -- have been better to use No_Uint instead of Uint_0. + + procedure Create_Node_Union (T : Abstract_Node; Children : Type_Array); + procedure Create_Entity_Union (T : Abstract_Entity; Children : Type_Array); + -- Create a "union" type that is the union of the Children. This is used + -- for nonhierachical types. This is the opposite of the normal "object + -- oriented" routines above, which create child types based on existing + -- parents. Here we are creating parent types based on existing child + -- types. A union type is considered to be an abstract type because it has + -- multiple children. We do not allow union types to have their own fields, + -- because that would introduce the well-known complexity of multiple + -- inheritance. That restriction could be relaxed, but for now, union types + -- are mainly for allowing things like "Pre => X in Some_Union_Type". + + Illegal : exception; + -- Exception raised when Gen_IL code (in particular in Gen_Nodes and + -- Gen_Entities) is illegal. We don't try elaborate error recovery, but + -- hopefully the exception message will indicate what's wrong. You might + -- have to go in the debugger to see which line it's complaining about. + + procedure Compile; + +private + + function Sy + (Field : Node_Field; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value := No_Default; + Pre : String := "") return Field_Sequence; + function Sm + (Field : Field_Enum; + Field_Type : Type_Enum; + Type_Only : Type_Only_Enum := No_Type_Only; + Pre : String := "") return Field_Sequence; + -- The above functions return Field_Sequence. This is a trick to get around + -- the fact that Ada doesn't allow singleton positional aggregates. It + -- allows us to write things like: + -- + -- Cc (N_Empty, Node_Kind, + -- (Sy (Chars, Name_Id, Default_No_Name))); + -- + -- where that thing pretending to be an aggregate is really a parenthesized + -- expression. + +end Gen_IL.Gen; diff --git a/gcc/ada/gen_il-main.adb b/gcc/ada/gen_il-main.adb new file mode 100644 index 00000000000..d6244061652 --- /dev/null +++ b/gcc/ada/gen_il-main.adb @@ -0,0 +1,34 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . M A I N -- +-- -- +-- 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 Gen_IL.Gen.Gen_Nodes; +with Gen_IL.Gen.Gen_Entities; + +procedure Gen_IL.Main is +begin + Gen_IL.Gen.Gen_Nodes; + Gen_IL.Gen.Gen_Entities; + Gen_IL.Gen.Compile; +end Gen_IL.Main; diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads new file mode 100644 index 00000000000..684d2bfb2c8 --- /dev/null +++ b/gcc/ada/gen_il-types.ads @@ -0,0 +1,496 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . T Y P E S -- +-- -- +-- 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. 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. -- +-- -- +------------------------------------------------------------------------------ + +package Gen_IL.Types is + + -- Enumeration of all the types that are "of interest". We have an + -- enumeration literal here for every node kind, every entity kind, + -- andevery type that can be the type of a field. + + -- The "Between_..." literals below are simply for making subranges. + -- When adding literals to this enumeration type, be sure to put them + -- in the right place so they end up in the appropriate subranges in + -- Gen_IL.Utils (Abstract_Node, Abstract_Entity, Concrete_Node, + -- Concrete_Entity). + + -- The following is "optional type enumeration" -- i.e. it is Type_Enum + -- (declared in Gen_IL.Utils) plus the special null value No_Type. + -- See the spec of Gen_IL.Gen for how to modify this. + + type Opt_Type_Enum is + (No_Type, + + Flag, + -- We use Flag for Boolean, so we don't conflict with + -- Standard.Boolean. + + Node_Id, + List_Id, + Elist_Id, + Name_Id, + String_Id, + Uint, + Ureal, + + Nkind_Type, -- Type of result of Nkind function, i.e. Node_Kind + Ekind_Type, -- Type of result of Ekind function, i.e. Entity_Kind + Source_Ptr, + Small_Paren_Count_Type, + Union_Id, + Convention_Id, + + Component_Alignment_Kind, + Float_Rep_Kind, + Mechanism_Type, + + Between_Special_And_Abstract_Node_Types, + + -- Abstract node types: + + Node_Kind, -- root of node type hierarchy + N_Access_To_Subprogram_Definition, + N_Array_Type_Definition, + N_Binary_Op, + N_Body_Stub, + N_Declaration, + N_Delay_Statement, + N_Direct_Name, + N_Entity, + N_Formal_Subprogram_Declaration, + N_Generic_Declaration, + N_Generic_Instantiation, + N_Generic_Renaming_Declaration, + N_Has_Chars, + N_Has_Entity, + N_Has_Etype, + N_Multiplying_Operator, + N_Later_Decl_Item, + N_Membership_Test, + N_Numeric_Or_String_Literal, + N_Op, + N_Op_Boolean, + N_Op_Compare, + N_Op_Shift, + N_Proper_Body, + N_Push_xxx_Label, + N_Pop_xxx_Label, + N_Push_Pop_xxx_Label, + N_Raise_xxx_Error, + N_Renaming_Declaration, + N_Representation_Clause, + N_Short_Circuit, + N_SCIL_Node, + N_Statement_Other_Than_Procedure_Call, + N_Subprogram_Call, + N_Subprogram_Instantiation, + N_Has_Condition, + N_Subexpr, + N_Subprogram_Specification, + N_Unary_Op, + N_Unit_Body, + + -- End of abstract node types. + + Between_Abstract_Node_And_Abstract_Entity_Types, + + -- Abstract entity types: + + Entity_Kind, -- root of entity type hierarchy + Access_Kind, + Access_Subprogram_Kind, + Access_Protected_Kind, + Aggregate_Kind, + Anonymous_Access_Kind, + Array_Kind, + Assignable_Kind, + Class_Wide_Kind, + Composite_Kind, + Concurrent_Kind, + Concurrent_Body_Kind, + Decimal_Fixed_Point_Kind, + Digits_Kind, + Discrete_Kind, + Discrete_Or_Fixed_Point_Kind, + Elementary_Kind, + Enumeration_Kind, + Entry_Kind, + Fixed_Point_Kind, + Float_Kind, + Formal_Kind, + Formal_Object_Kind, + Generic_Subprogram_Kind, + Generic_Unit_Kind, + Incomplete_Kind, + Incomplete_Or_Private_Kind, + Integer_Kind, + Modular_Integer_Kind, + Named_Kind, + Numeric_Kind, + Object_Kind, + Ordinary_Fixed_Point_Kind, + Overloadable_Kind, + Private_Kind, + Protected_Kind, + Real_Kind, + Record_Kind, + Scalar_Kind, + Subprogram_Kind, + Signed_Integer_Kind, + Task_Kind, + Type_Kind, + + -- End of abstract entity types. + + Between_Abstract_Entity_And_Concrete_Node_Types, + + -- Concrete node types: + + N_Unused_At_Start, + N_At_Clause, + N_Component_Clause, + N_Enumeration_Representation_Clause, + N_Mod_Clause, + N_Record_Representation_Clause, + N_Attribute_Definition_Clause, + N_Empty, + N_Pragma_Argument_Association, + N_Error, + N_Defining_Character_Literal, + N_Defining_Identifier, + N_Defining_Operator_Symbol, + N_Expanded_Name, + N_Identifier, + N_Operator_Symbol, + N_Character_Literal, + N_Op_Add, + N_Op_Concat, + N_Op_Expon, + N_Op_Subtract, + N_Op_Divide, + N_Op_Mod, + N_Op_Multiply, + N_Op_Rem, + N_Op_And, + N_Op_Eq, + N_Op_Ge, + N_Op_Gt, + N_Op_Le, + N_Op_Lt, + N_Op_Ne, + N_Op_Or, + N_Op_Xor, + N_Op_Rotate_Left, + N_Op_Rotate_Right, + N_Op_Shift_Left, + N_Op_Shift_Right, + N_Op_Shift_Right_Arithmetic, + N_Op_Abs, + N_Op_Minus, + N_Op_Not, + N_Op_Plus, + N_Attribute_Reference, + N_In, + N_Not_In, + N_And_Then, + N_Or_Else, + N_Function_Call, + N_Procedure_Call_Statement, + N_Raise_Constraint_Error, + N_Raise_Program_Error, + N_Raise_Storage_Error, + N_Integer_Literal, + N_Real_Literal, + N_String_Literal, + N_Explicit_Dereference, + N_Expression_With_Actions, + N_If_Expression, + N_Indexed_Component, + N_Null, + N_Qualified_Expression, + N_Quantified_Expression, + N_Aggregate, + N_Allocator, + N_Case_Expression, + N_Delta_Aggregate, + N_Extension_Aggregate, + N_Raise_Expression, + N_Range, + N_Reference, + N_Selected_Component, + N_Slice, + N_Target_Name, + N_Type_Conversion, + N_Unchecked_Expression, + N_Unchecked_Type_Conversion, + N_Subtype_Indication, + N_Component_Declaration, + N_Entry_Declaration, + N_Expression_Function, + N_Formal_Object_Declaration, + N_Formal_Type_Declaration, + N_Full_Type_Declaration, + N_Incomplete_Type_Declaration, + N_Iterator_Specification, + N_Loop_Parameter_Specification, + N_Object_Declaration, + N_Protected_Type_Declaration, + N_Private_Extension_Declaration, + N_Private_Type_Declaration, + N_Subtype_Declaration, + N_Function_Specification, + N_Procedure_Specification, + N_Access_Function_Definition, + N_Access_Procedure_Definition, + N_Task_Type_Declaration, + N_Package_Body_Stub, + N_Protected_Body_Stub, + N_Subprogram_Body_Stub, + N_Task_Body_Stub, + N_Function_Instantiation, + N_Procedure_Instantiation, + N_Package_Instantiation, + N_Package_Body, + N_Subprogram_Body, + N_Protected_Body, + N_Task_Body, + N_Implicit_Label_Declaration, + N_Package_Declaration, + N_Single_Task_Declaration, + N_Subprogram_Declaration, + N_Use_Package_Clause, + N_Generic_Package_Declaration, + N_Generic_Subprogram_Declaration, + N_Constrained_Array_Definition, + N_Unconstrained_Array_Definition, + N_Exception_Renaming_Declaration, + N_Object_Renaming_Declaration, + N_Package_Renaming_Declaration, + N_Subprogram_Renaming_Declaration, + N_Generic_Function_Renaming_Declaration, + N_Generic_Package_Renaming_Declaration, + N_Generic_Procedure_Renaming_Declaration, + N_Abort_Statement, + N_Accept_Statement, + N_Assignment_Statement, + N_Asynchronous_Select, + N_Block_Statement, + N_Case_Statement, + N_Code_Statement, + N_Compound_Statement, + N_Conditional_Entry_Call, + N_Delay_Relative_Statement, + N_Delay_Until_Statement, + N_Entry_Call_Statement, + N_Free_Statement, + N_Goto_Statement, + N_Loop_Statement, + N_Null_Statement, + N_Raise_Statement, + N_Requeue_Statement, + N_Simple_Return_Statement, + N_Extended_Return_Statement, + N_Selective_Accept, + N_Timed_Entry_Call, + N_Exit_Statement, + N_If_Statement, + N_Accept_Alternative, + N_Delay_Alternative, + N_Elsif_Part, + N_Entry_Body_Formal_Part, + N_Iteration_Scheme, + N_Terminate_Alternative, + N_Formal_Abstract_Subprogram_Declaration, + N_Formal_Concrete_Subprogram_Declaration, + N_Push_Constraint_Error_Label, + N_Push_Program_Error_Label, + N_Push_Storage_Error_Label, + N_Pop_Constraint_Error_Label, + N_Pop_Program_Error_Label, + N_Pop_Storage_Error_Label, + N_SCIL_Dispatch_Table_Tag_Init, + N_SCIL_Dispatching_Call, + N_SCIL_Membership_Test, + N_Abortable_Part, + N_Abstract_Subprogram_Declaration, + N_Access_Definition, + N_Access_To_Object_Definition, + N_Aspect_Specification, + N_Call_Marker, + N_Case_Expression_Alternative, + N_Case_Statement_Alternative, + N_Compilation_Unit, + N_Compilation_Unit_Aux, + N_Component_Association, + N_Component_Definition, + N_Component_List, + N_Contract, + N_Derived_Type_Definition, + N_Decimal_Fixed_Point_Definition, + N_Defining_Program_Unit_Name, + N_Delta_Constraint, + N_Designator, + N_Digits_Constraint, + N_Discriminant_Association, + N_Discriminant_Specification, + N_Enumeration_Type_Definition, + N_Entry_Body, + N_Entry_Call_Alternative, + N_Entry_Index_Specification, + N_Exception_Declaration, + N_Exception_Handler, + N_Floating_Point_Definition, + N_Formal_Decimal_Fixed_Point_Definition, + N_Formal_Derived_Type_Definition, + N_Formal_Discrete_Type_Definition, + N_Formal_Floating_Point_Definition, + N_Formal_Modular_Type_Definition, + N_Formal_Ordinary_Fixed_Point_Definition, + N_Formal_Package_Declaration, + N_Formal_Private_Type_Definition, + N_Formal_Incomplete_Type_Definition, + N_Formal_Signed_Integer_Type_Definition, + N_Freeze_Entity, + N_Freeze_Generic_Entity, + N_Generic_Association, + N_Handled_Sequence_Of_Statements, + N_Index_Or_Discriminant_Constraint, + N_Iterated_Component_Association, + N_Iterated_Element_Association, + N_Itype_Reference, + N_Label, + N_Modular_Type_Definition, + N_Number_Declaration, + N_Ordinary_Fixed_Point_Definition, + N_Others_Choice, + N_Package_Specification, + N_Parameter_Association, + N_Parameter_Specification, + N_Pragma, + N_Protected_Definition, + N_Range_Constraint, + N_Real_Range_Specification, + N_Record_Definition, + N_Signed_Integer_Type_Definition, + N_Single_Protected_Declaration, + N_Subunit, + N_Task_Definition, + N_Triggering_Alternative, + N_Use_Type_Clause, + N_Validate_Unchecked_Conversion, + N_Variable_Reference_Marker, + N_Variant, + N_Variant_Part, + N_With_Clause, + N_Unused_At_End, + + -- End of concrete node types. + + Between_Concrete_Node_And_Concrete_Entity_Types, + + -- Concrete entity types: + + E_Void, + E_Component, + E_Constant, + E_Discriminant, + E_Loop_Parameter, + E_Variable, + E_Out_Parameter, + E_In_Out_Parameter, + E_In_Parameter, + E_Generic_In_Out_Parameter, + E_Generic_In_Parameter, + E_Named_Integer, + E_Named_Real, + E_Enumeration_Type, + E_Enumeration_Subtype, + E_Signed_Integer_Type, + E_Signed_Integer_Subtype, + E_Modular_Integer_Type, + E_Modular_Integer_Subtype, + E_Ordinary_Fixed_Point_Type, + E_Ordinary_Fixed_Point_Subtype, + E_Decimal_Fixed_Point_Type, + E_Decimal_Fixed_Point_Subtype, + E_Floating_Point_Type, + E_Floating_Point_Subtype, + E_Access_Type, + E_Access_Subtype, + E_Access_Attribute_Type, + E_Allocator_Type, + E_General_Access_Type, + E_Access_Subprogram_Type, + E_Access_Protected_Subprogram_Type, + E_Anonymous_Access_Protected_Subprogram_Type, + E_Anonymous_Access_Subprogram_Type, + E_Anonymous_Access_Type, + E_Array_Type, + E_Array_Subtype, + E_String_Literal_Subtype, + E_Class_Wide_Type, + E_Class_Wide_Subtype, + E_Record_Type, + E_Record_Subtype, + E_Record_Type_With_Private, + E_Record_Subtype_With_Private, + E_Private_Type, + E_Private_Subtype, + E_Limited_Private_Type, + E_Limited_Private_Subtype, + E_Incomplete_Type, + E_Incomplete_Subtype, + E_Task_Type, + E_Task_Subtype, + E_Protected_Type, + E_Protected_Subtype, + E_Exception_Type, + E_Subprogram_Type, + E_Enumeration_Literal, + E_Function, + E_Operator, + E_Procedure, + E_Abstract_State, + E_Entry, + E_Entry_Family, + E_Block, + E_Entry_Index_Parameter, + E_Exception, + E_Generic_Function, + E_Generic_Procedure, + E_Generic_Package, + E_Label, + E_Loop, + E_Return_Statement, + E_Package, + E_Package_Body, + E_Protected_Body, + E_Task_Body, + E_Subprogram_Body + + -- End of concrete entity types. + + ); -- Type_Enum + +end Gen_IL.Types; diff --git a/gcc/ada/gen_il-utils.adb b/gcc/ada/gen_il-utils.adb new file mode 100644 index 00000000000..21acd9bfe25 --- /dev/null +++ b/gcc/ada/gen_il-utils.adb @@ -0,0 +1,453 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . 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. -- +-- -- +------------------------------------------------------------------------------ + +package body Gen_IL.Utils is + + procedure Nil (T : Node_Or_Entity_Type) is + begin + null; + end Nil; + + function Node_Or_Entity (Root : Root_Type) return String is + begin + if Root = Node_Kind then + return "Node"; + else + return "Entity"; + end if; + end Node_Or_Entity; + + function Num_Concrete_Descendants + (T : Node_Or_Entity_Type) return Natural is + begin + return Concrete_Type'Pos (Type_Table (T).Last) - + Concrete_Type'Pos (Type_Table (T).First) + 1; + end Num_Concrete_Descendants; + + function First_Abstract (Root : Root_Type) return Abstract_Type is + (case Root is + when Node_Kind => Abstract_Node'First, + when others => Abstract_Entity'First); -- Entity_Kind + function Last_Abstract (Root : Root_Type) return Abstract_Type is + (case Root is + when Node_Kind => Abstract_Node'Last, + when others => Abstract_Entity'Last); -- Entity_Kind + + function First_Concrete (Root : Root_Type) return Concrete_Type is + (case Root is + when Node_Kind => Concrete_Node'First, + when others => Concrete_Entity'First); -- Entity_Kind + function Last_Concrete (Root : Root_Type) return Concrete_Type is + (case Root is + when Node_Kind => Concrete_Node'Last, + when others => Concrete_Entity'Last); -- Entity_Kind + + function First_Field (Root : Root_Type) return Field_Enum is + (case Root is + when Node_Kind => Node_Field'First, + when others => Entity_Field'First); -- Entity_Kind + function Last_Field (Root : Root_Type) return Field_Enum is + (case Root is + when Node_Kind => Node_Field'Last, + when others => Entity_Field'Last); -- Entity_Kind + -- First and Last node or entity fields + + procedure Verify_Type_Table is + begin + for T in Node_Or_Entity_Type loop + if Type_Table (T) /= null then + if not Type_Table (T).Is_Union then + case T is + when Concrete_Node | Concrete_Entity => + pragma Assert (Type_Table (T).First = T); + pragma Assert (Type_Table (T).Last = T); + + when Abstract_Node | Abstract_Entity => + pragma Assert + (Type_Table (T).First < Type_Table (T).Last); + + when Boundaries => + null; + end case; + end if; + end if; + end loop; + end Verify_Type_Table; + + function Id_Image (T : Type_Enum) return String is + begin + case T is + when Flag => + return "Boolean"; + when Node_Kind => + return "Node_Id"; + when Entity_Kind => + return "Entity_Id"; + when Nkind_Type => + return "Node_Kind"; + when Ekind_Type => + return "Entity_Kind"; + when others => + return Image (T) & "_Id"; + end case; + end Id_Image; + + function Get_Set_Id_Image (T : Type_Enum) return String is + begin + case T is + when Node_Kind => + return "Node_Id"; + when Entity_Kind => + return "Entity_Id"; + when Nkind_Type => + return "Node_Kind"; + when Ekind_Type => + return "Entity_Kind"; + when others => + return Image (T); + end case; + end Get_Set_Id_Image; + + function Image (T : Opt_Type_Enum) return String is + begin + case T is + -- We special case the following; otherwise the compiler will give + -- "wrong case" warnings in compiler code. + + when N_Pop_xxx_Label => + return "N_Pop_xxx_Label"; + + when N_Push_Pop_xxx_Label => + return "N_Push_Pop_xxx_Label"; + + when N_Push_xxx_Label => + return "N_Push_xxx_Label"; + + when N_Raise_xxx_Error => + return "N_Raise_xxx_Error"; + + when N_SCIL_Node => + return "N_SCIL_Node"; + + when N_SCIL_Dispatch_Table_Tag_Init => + return "N_SCIL_Dispatch_Table_Tag_Init"; + + when N_SCIL_Dispatching_Call => + return "N_SCIL_Dispatching_Call"; + + when N_SCIL_Membership_Test => + return "N_SCIL_Membership_Test"; + + when others => + return Capitalize (T'Img); + end case; + end Image; + + function Image_Sans_N (T : Opt_Type_Enum) return String is + Im : constant String := Image (T); + pragma Assert (Im (1 .. 2) = "N_"); + begin + return Im (3 .. Im'Last); + end Image_Sans_N; + + procedure Put_Images (S : in out Sink'Class; U : Type_Vector) is + First_Time : Boolean := True; + begin + Indent (S, 3); + + for T of U loop + if First_Time then + First_Time := False; + else + Put (S, "\n| "); + end if; + + Put (S, "\1", Image (T)); + end loop; + + Outdent (S, 3); + end Put_Images; + + procedure Put_Id_Images (S : in out Sink'Class; U : Type_Vector) is + First_Time : Boolean := True; + begin + Indent (S, 3); + + for T of U loop + if First_Time then + First_Time := False; + else + Put (S, "\n| "); + end if; + + Put (S, "\1", Id_Image (T)); + end loop; + + Outdent (S, 3); + end Put_Id_Images; + + function Image (F : Opt_Field_Enum) return String is + begin + case F is + -- Special cases for the same reason as in the above Image + -- function. + + when Alloc_For_BIP_Return => + return "Alloc_For_BIP_Return"; + when Assignment_OK => + return "Assignment_OK"; + when Backwards_OK => + return "Backwards_OK"; + when BIP_Initialization_Call => + return "BIP_Initialization_Call"; + when Body_Needed_For_SAL => + return "Body_Needed_For_SAL"; + when Conversion_OK => + return "Conversion_OK"; + when CR_Discriminant => + return "CR_Discriminant"; + when DTC_Entity => + return "DTC_Entity"; + when DT_Entry_Count => + return "DT_Entry_Count"; + when DT_Offset_To_Top_Func => + return "DT_Offset_To_Top_Func"; + when DT_Position => + return "DT_Position"; + when Forwards_OK => + return "Forwards_OK"; + when Has_Inherited_DIC => + return "Has_Inherited_DIC"; + when Has_Own_DIC => + return "Has_Own_DIC"; + when Has_RACW => + return "Has_RACW"; + when Has_SP_Choice => + return "Has_SP_Choice"; + when Ignore_SPARK_Mode_Pragmas => + return "Ignore_SPARK_Mode_Pragmas"; + when Is_Constr_Subt_For_UN_Aliased => + return "Is_Constr_Subt_For_UN_Aliased"; + when Is_CPP_Class => + return "Is_CPP_Class"; + when Is_CUDA_Kernel => + return "Is_CUDA_Kernel"; + when Is_DIC_Procedure => + return "Is_DIC_Procedure"; + when Is_Discrim_SO_Function => + return "Is_Discrim_SO_Function"; + when Is_Elaboration_Checks_OK_Id => + return "Is_Elaboration_Checks_OK_Id"; + when Is_Elaboration_Checks_OK_Node => + return "Is_Elaboration_Checks_OK_Node"; + when Is_Elaboration_Warnings_OK_Id => + return "Is_Elaboration_Warnings_OK_Id"; + when Is_Elaboration_Warnings_OK_Node => + return "Is_Elaboration_Warnings_OK_Node"; + when Is_Known_Guaranteed_ABE => + return "Is_Known_Guaranteed_ABE"; + when Is_RACW_Stub_Type => + return "Is_RACW_Stub_Type"; + when Is_SPARK_Mode_On_Node => + return "Is_SPARK_Mode_On_Node"; + when Local_Raise_Not_OK => + return "Local_Raise_Not_OK"; + when OK_To_Rename => + return "OK_To_Rename"; + when Referenced_As_LHS => + return "Referenced_As_LHS"; + when RM_Size => + return "RM_Size"; + when SCIL_Controlling_Tag => + return "SCIL_Controlling_Tag"; + when SCIL_Entity => + return "SCIL_Entity"; + when SCIL_Tag_Value => + return "SCIL_Tag_Value"; + when SCIL_Target_Prim => + return "SCIL_Target_Prim"; + when Shift_Count_OK => + return "Shift_Count_OK"; + when SPARK_Aux_Pragma => + return "SPARK_Aux_Pragma"; + when SPARK_Aux_Pragma_Inherited => + return "SPARK_Aux_Pragma_Inherited"; + when SPARK_Pragma => + return "SPARK_Pragma"; + when SPARK_Pragma_Inherited => + return "SPARK_Pragma_Inherited"; + when Split_PPC => + return "Split_PPC"; + when SSO_Set_High_By_Default => + return "SSO_Set_High_By_Default"; + when SSO_Set_Low_By_Default => + return "SSO_Set_Low_By_Default"; + when TSS_Elist => + return "TSS_Elist"; + + when others => + return Capitalize (F'Img); + end case; + end Image; + + function Image (Default : Field_Default_Value) return String is + (Capitalize (Default'Img)); + + function Value_Image (Default : Field_Default_Value) return String is + begin + if Default = No_Default then + return Image (Default); + + else + -- Strip off the prefix and capitalize it + + declare + Im : constant String := Image (Default); + Prefix : constant String := "Default_"; + begin + pragma Assert (Im (1 .. Prefix'Length) = Prefix); + return Im (Prefix'Length + 1 .. Im'Last); + end; + end if; + end Value_Image; + + procedure Iterate_Types + (Root : Node_Or_Entity_Type; + Pre, Post : not null access procedure (T : Node_Or_Entity_Type) := + Nil'Access) + is + procedure Recursive (T : Node_Or_Entity_Type); + -- Recursive walk + + procedure Recursive (T : Node_Or_Entity_Type) is + begin + Pre (T); + + for Child of Type_Table (T).Children loop + Recursive (Child); + end loop; + + Post (T); + end Recursive; + + begin + Recursive (Root); + end Iterate_Types; + + function Is_Descendant (Ancestor, Descendant : Node_Or_Entity_Type) + return Boolean is + begin + if Ancestor = Descendant then + return True; + + elsif Descendant in Root_Type then + return False; + + else + return Is_Descendant (Ancestor, Type_Table (Descendant).Parent); + end if; + end Is_Descendant; + + procedure Put_Type_Hierarchy (S : in out Sink'Class; Root : Root_Type) is + Level : Natural := 0; + + function Indentation return String is ((1 .. 3 * Level => ' ')); + -- Indentation string of space characters. We can't use the Indent + -- primitive, because we want this indentation after the "--". + + procedure Pre (T : Node_Or_Entity_Type); + procedure Post (T : Node_Or_Entity_Type); + -- Pre and Post actions passed to Iterate_Types + + procedure Pre (T : Node_Or_Entity_Type) is + begin + if not Type_Table (T).Allow_Overlap then + Put (S, "-- \1\2\n", Indentation, Image (T)); + end if; + + Level := Level + 1; + end Pre; + + procedure Post (T : Node_Or_Entity_Type) is + begin + Level := Level - 1; + + if not Type_Table (T).Allow_Overlap then + -- Put out an "end" line only if there are many descendants, for + -- an arbitrary definition of "many". + + if Num_Concrete_Descendants (T) > 10 then + Put (S, "-- \1end \2\n", Indentation, Image (T)); + end if; + end if; + end Post; + + N_Or_E : constant String := + (case Root is + when Node_Kind => "nodes", + when others => "entities"); -- Entity_Kind + + begin + Put (S, "-- Type hierarchy for \1\n", N_Or_E); + Put (S, "--\n"); + + Iterate_Types (Root, Pre'Access, Post'Access); + + Put (S, "--\n"); + Put (S, "-- End type hierarchy for \1\n\n", N_Or_E); + end Put_Type_Hierarchy; + + function Pos (T : Concrete_Type) return Root_Nat is + First : constant Concrete_Type := + (if T in Concrete_Node then Concrete_Node'First + else Concrete_Entity'First); + begin + 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.Utils; diff --git a/gcc/ada/gen_il-utils.ads b/gcc/ada/gen_il-utils.ads new file mode 100644 index 00000000000..f264a5f5650 --- /dev/null +++ b/gcc/ada/gen_il-utils.ads @@ -0,0 +1,558 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L . U T I L S -- +-- -- +-- 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. 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 Ada.Containers.Vectors; use Ada.Containers; + +with Gen_IL.Types; use Gen_IL.Types; +with Gen_IL.Fields; use Gen_IL.Fields; + +package Gen_IL.Utils is + + subtype Type_Enum is Opt_Type_Enum + range Opt_Type_Enum'Succ (No_Type) .. Opt_Type_Enum'Last; + -- Enumeration of types -- Opt_Type_Enum without the special null value + -- No_Type. + + subtype Node_Or_Entity_Type is + Type_Enum range + Type_Enum'Succ (Between_Special_And_Abstract_Node_Types) .. + Type_Enum'Last; + + subtype Abstract_Type is + Type_Enum range + Type_Enum'Succ (Between_Special_And_Abstract_Node_Types) .. + Type_Enum'Pred (Between_Abstract_Entity_And_Concrete_Node_Types); + subtype Abstract_Node is + Abstract_Type range + Type_Enum'Succ (Between_Special_And_Abstract_Node_Types) .. + Type_Enum'Pred (Between_Abstract_Node_And_Abstract_Entity_Types); + subtype Abstract_Entity is + Abstract_Type range + Type_Enum'Succ (Between_Abstract_Node_And_Abstract_Entity_Types) .. + Type_Enum'Pred (Between_Abstract_Entity_And_Concrete_Node_Types); + + subtype Concrete_Type is + Type_Enum range + Type_Enum'Succ (Between_Abstract_Entity_And_Concrete_Node_Types) .. + Type_Enum'Last; + subtype Concrete_Node is + Concrete_Type range + Type_Enum'Succ (Between_Abstract_Entity_And_Concrete_Node_Types) .. + Type_Enum'Pred (Between_Concrete_Node_And_Concrete_Entity_Types); + subtype Concrete_Entity is + Concrete_Type range + Type_Enum'Succ (Between_Concrete_Node_And_Concrete_Entity_Types) .. + Type_Enum'Last; + + subtype Root_Type is Abstract_Type with + Predicate => Root_Type in Node_Kind | Entity_Kind; + + subtype Node_Type is Node_Or_Entity_Type with + Predicate => Node_Type in Abstract_Node | Concrete_Node; + subtype Entity_Type is Node_Or_Entity_Type with + Predicate => Entity_Type in Abstract_Entity | Concrete_Entity; + + subtype Special_Type is Type_Enum range + Flag .. Type_Enum'Pred (Between_Special_And_Abstract_Node_Types); + + subtype Traversal_Type is Type_Enum with Predicate => + Traversal_Type in Node_Id | List_Id | Node_Type; + -- These are the types of fields traversed by Traverse_Func + + subtype Entity_Node is Node_Type with + Predicate => Entity_Node in + N_Defining_Character_Literal + | N_Defining_Identifier + | N_Defining_Operator_Symbol; + + function Image (T : Opt_Type_Enum) return String; + + function Image_Sans_N (T : Opt_Type_Enum) return String; + -- Returns the image without the leading "N_" + + subtype Boundaries is Type_Enum with + Predicate => Boundaries in + Between_Abstract_Node_And_Abstract_Entity_Types | + Between_Abstract_Entity_And_Concrete_Node_Types | + Between_Concrete_Node_And_Concrete_Entity_Types; + + ---------------- + + type Type_Set is array (Type_Enum) of Boolean; + + type Type_Index is new Positive; + subtype Type_Count is Type_Index'Base range 0 .. Type_Index'Last; + package Type_Vectors is new Vectors (Type_Index, Type_Enum); + 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; + + subtype Field_Enum is Opt_Field_Enum + range Opt_Field_Enum'Succ (No_Field) .. Opt_Field_Enum'Last; + -- Enumeration of fields -- Opt_Field_Enum without the special null value + -- No_Field. + + subtype Node_Header_Type is Type_Enum range + Nkind_Type .. Union_Id; + subtype Node_Header_Field is Field_Enum with Predicate => + Node_Header_Field in Nkind .. Link | Ekind; + + type Fields_Present_Array is array (Field_Enum) of Type_Set; + + type Field_Set is array (Field_Enum) of Boolean; + type Fields_Per_Node_Type is array (Node_Or_Entity_Type) of Field_Set; + + type Field_Index is new Positive; + subtype Field_Count is Field_Index'Base range 0 .. Field_Index'Last; + package Field_Vectors is new Vectors (Field_Index, Field_Enum); + subtype Field_Vector is Field_Vectors.Vector; + procedure Pfields (V : Field_Vector); -- for debugging + + subtype Opt_Abstract_Type is Opt_Type_Enum with + Predicate => Opt_Abstract_Type = No_Type or + Opt_Abstract_Type in Abstract_Type; + + procedure Put_Images (S : in out Sink'Class; U : Type_Vector); + procedure Put_Id_Images (S : in out Sink'Class; U : Type_Vector); + -- Put the types with vertical bars in between, as in + -- N_This | N_That | N_Other + -- or + -- N_This_Id | N_That_Id | N_Other_Id + + function Id_Image (T : Type_Enum) return String; + function Get_Set_Id_Image (T : Type_Enum) return String; + + type Bit_Offset is new Root_Nat range 0 .. 32_000 - 1; + -- There are fewer than 1000 fields. But offsets are in size units (1 bit + -- for flags, 32 bits for most others, also 2, 4, and 8). + + type Field_Offset is new Bit_Offset; + + type Type_Info (Is_Union : Boolean) is record + Parent : Opt_Abstract_Type; + -- Parent of this type (single inheritance). No_Type for a root + -- type (Node_Kind or Entity_Kind). For union types, this is + -- a root type. + + Children : Type_Vector; + -- Inverse of Parent + + Concrete_Descendants : Type_Vector; + + case Is_Union is + when True => + null; + + when False => + First, Last : Concrete_Type; + -- This type includes concrete types in the range First..Last. For + -- a concrete type, First=Last. For an abstract type, First..Last + -- includes two or more types. + + Fields : Field_Vector; + + Allow_Overlap : Boolean; + -- True to allow overlapping subranges + end case; + end record; + + type Type_Info_Ptr is access all Type_Info; + + Type_Table : array (Node_Or_Entity_Type) of Type_Info_Ptr; + -- Table mapping from enumeration literals representing types to + -- information about the type. + + function Num_Concrete_Descendants + (T : Node_Or_Entity_Type) return Natural; + -- Number of concrete descendants of T, including (if T is concrete) + -- itself. + + type Field_Default_Value is + (No_Default, + Default_Empty, -- Node_Id + Default_No_List, Default_Empty_List, -- List_Id + Default_False, Default_True, -- Flag + Default_No_Elist, -- Elist_Id + Default_No_Name, -- Name_Id + Default_Uint_0); -- Uint + -- Default value for a field in the Nmake functions. No_Default if the + -- field parameter has no default value. Otherwise this indicates the + -- default value used, which must matcht the type of the field. + + type Type_Only_Enum is + (No_Type_Only, Base_Type_Only, Impl_Base_Type_Only, Root_Type_Only); + -- ????These correspond to the "[base type only]", "[implementation base + -- type only]", and "[root type only]" annotations in the old einfo.ads. + -- Move the relevant comments here. There is no comment explaining + -- [root type only] in the old einfo.ads. + + function Image (Default : Field_Default_Value) return String; + function Value_Image (Default : Field_Default_Value) return String; + + type Field_Info is record + Have_This_Field : Type_Vector; + + Field_Type : Type_Enum; + -- Type of the field. Currently, we use Node_Id for all node-valued + -- fields, but we could narrow down to children of that. Similar for + -- Entity_Id. + + Default_Value : Field_Default_Value; + Type_Only : Type_Only_Enum; + Pre : String_Ptr; + + Offset : Field_Offset; + -- Offset of the field, in units of the field size. So if a field is 4 + -- bits, it starts at bit number Offset*4 from the start of the node. + end record; + + type Field_Info_Ptr is access all Field_Info; + + Field_Table : array (Field_Enum) of Field_Info_Ptr; + -- Table mapping from enumeration literals representing fields to + -- information about the field. + + procedure Verify_Type_Table; + + ---------------- + + subtype Node_Field is + Field_Enum range + Field_Enum'First .. + Field_Enum'Pred (Between_Node_And_Entity_Fields); + + subtype Entity_Field is + Field_Enum range + Field_Enum'Succ (Between_Node_And_Entity_Fields) .. + Field_Enum'Last; + + function Image (F : Opt_Field_Enum) return String; + + procedure Nil (T : Node_Or_Entity_Type); + -- Null procedure + + procedure Iterate_Types + (Root : Node_Or_Entity_Type; + Pre, Post : not null access procedure (T : Node_Or_Entity_Type) := + Nil'Access); + -- Iterate top-down on the type hierarchy. Call Pre and Post before and + -- after walking child types. Note that this ignores union types, because + -- they are nonhierarchical. + + function Is_Descendant (Ancestor, Descendant : Node_Or_Entity_Type) + return Boolean; + -- True if Descendant is a descendant of Ancestor; that 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); + + function Pos (T : Concrete_Type) return Root_Nat; + -- Return Node_Kind'Pos (T) or Entity_Kind'Pos (T) + + ---------------- + + -- The same field can be syntactic in some nodes but semantic in others: + + type Field_Desc is record + F : Field_Enum; + Is_Syntactic : Boolean; + end record; + + type Field_Sequence_Index is new Positive; + type Field_Sequence is array (Field_Sequence_Index range <>) of Field_Desc; + No_Fields : constant Field_Sequence := (1 .. 0 => <>); + + type Field_Array is array (Bit_Offset range <>) of Opt_Field_Enum; + type Field_Array_Ptr is access all Field_Array; + + type Type_Layout_Array is array (Concrete_Type) of Field_Array_Ptr; + -- Mapping from types to mappings from offsets to fields + + type Offset_To_Fields_Mapping is + array (Bit_Offset range <>) of Field_Array_Ptr; + -- Mapping from bit offsets to fields using that offset + + function First_Abstract (Root : Root_Type) return Abstract_Type; + function Last_Abstract (Root : Root_Type) return Abstract_Type; + -- First and Last abstract types descended from the Root + + function First_Concrete (Root : Root_Type) return Concrete_Type; + function Last_Concrete (Root : Root_Type) return Concrete_Type; + -- First and Last concrete types descended from the Root + + function First_Field (Root : Root_Type) return Field_Enum; + function Last_Field (Root : Root_Type) return Field_Enum; + -- First and Last node or entity fields + + function Node_Or_Entity (Root : Root_Type) return String; + -- Return "Node" or "Entity" depending on whether Root = Node_Kind + + type Sinfo_Node_Order_Index is new Positive; + Sinfo_Node_Order : + constant array (Sinfo_Node_Order_Index range <>) of Node_Type := + -- The order in which the documentation of node kinds appears in the old + -- sinfo.ads. This is the same order of the functions in Nmake. + -- Sinfo_Node_Order was constructed by massaging nmake.ads. + (N_Unused_At_Start, + N_Unused_At_End, + N_Identifier, + N_Integer_Literal, + N_Real_Literal, + N_Character_Literal, + N_String_Literal, + N_Pragma, + N_Pragma_Argument_Association, + N_Defining_Identifier, + N_Full_Type_Declaration, + N_Subtype_Declaration, + N_Subtype_Indication, + N_Object_Declaration, + N_Number_Declaration, + N_Derived_Type_Definition, + N_Range_Constraint, + N_Range, + N_Enumeration_Type_Definition, + N_Defining_Character_Literal, + N_Signed_Integer_Type_Definition, + N_Modular_Type_Definition, + N_Floating_Point_Definition, + N_Real_Range_Specification, + N_Ordinary_Fixed_Point_Definition, + N_Decimal_Fixed_Point_Definition, + N_Digits_Constraint, + N_Unconstrained_Array_Definition, + N_Constrained_Array_Definition, + N_Component_Definition, + N_Discriminant_Specification, + N_Index_Or_Discriminant_Constraint, + N_Discriminant_Association, + N_Record_Definition, + N_Component_List, + N_Component_Declaration, + N_Variant_Part, + N_Variant, + N_Others_Choice, + N_Access_To_Object_Definition, + N_Access_Function_Definition, + N_Access_Procedure_Definition, + N_Access_Definition, + N_Incomplete_Type_Declaration, + N_Explicit_Dereference, + N_Indexed_Component, + N_Slice, + N_Selected_Component, + N_Attribute_Reference, + N_Aggregate, + N_Component_Association, + N_Extension_Aggregate, + N_Iterated_Component_Association, + N_Delta_Aggregate, + N_Iterated_Element_Association, + N_Null, + N_And_Then, + N_Or_Else, + N_In, + N_Not_In, + N_Op_And, + N_Op_Or, + N_Op_Xor, + N_Op_Eq, + N_Op_Ne, + N_Op_Lt, + N_Op_Le, + N_Op_Gt, + N_Op_Ge, + N_Op_Add, + N_Op_Subtract, + N_Op_Concat, + N_Op_Multiply, + N_Op_Divide, + N_Op_Mod, + N_Op_Rem, + N_Op_Expon, + N_Op_Plus, + N_Op_Minus, + N_Op_Abs, + N_Op_Not, + N_If_Expression, + N_Case_Expression, + N_Case_Expression_Alternative, + N_Quantified_Expression, + N_Type_Conversion, + N_Qualified_Expression, + N_Allocator, + N_Null_Statement, + N_Label, + N_Assignment_Statement, + N_Target_Name, + N_If_Statement, + N_Elsif_Part, + N_Case_Statement, + N_Case_Statement_Alternative, + N_Loop_Statement, + N_Iteration_Scheme, + N_Loop_Parameter_Specification, + N_Iterator_Specification, + N_Block_Statement, + N_Exit_Statement, + N_Goto_Statement, + N_Subprogram_Declaration, + N_Abstract_Subprogram_Declaration, + N_Function_Specification, + N_Procedure_Specification, + N_Designator, + N_Defining_Program_Unit_Name, + N_Operator_Symbol, + N_Defining_Operator_Symbol, + N_Parameter_Specification, + N_Subprogram_Body, + N_Procedure_Call_Statement, + N_Function_Call, + N_Parameter_Association, + N_Simple_Return_Statement, + N_Extended_Return_Statement, + N_Expression_Function, + N_Package_Declaration, + N_Package_Specification, + N_Package_Body, + N_Private_Type_Declaration, + N_Private_Extension_Declaration, + N_Use_Package_Clause, + N_Use_Type_Clause, + N_Object_Renaming_Declaration, + N_Exception_Renaming_Declaration, + N_Package_Renaming_Declaration, + N_Subprogram_Renaming_Declaration, + N_Generic_Package_Renaming_Declaration, + N_Generic_Procedure_Renaming_Declaration, + N_Generic_Function_Renaming_Declaration, + N_Task_Type_Declaration, + N_Single_Task_Declaration, + N_Task_Definition, + N_Task_Body, + N_Protected_Type_Declaration, + N_Single_Protected_Declaration, + N_Protected_Definition, + N_Protected_Body, + N_Entry_Declaration, + N_Accept_Statement, + N_Entry_Body, + N_Entry_Body_Formal_Part, + N_Entry_Index_Specification, + N_Entry_Call_Statement, + N_Requeue_Statement, + N_Delay_Until_Statement, + N_Delay_Relative_Statement, + N_Selective_Accept, + N_Accept_Alternative, + N_Delay_Alternative, + N_Terminate_Alternative, + N_Timed_Entry_Call, + N_Entry_Call_Alternative, + N_Conditional_Entry_Call, + N_Asynchronous_Select, + N_Triggering_Alternative, + N_Abortable_Part, + N_Abort_Statement, + N_Compilation_Unit, + N_Compilation_Unit_Aux, + N_With_Clause, + N_Subprogram_Body_Stub, + N_Package_Body_Stub, + N_Task_Body_Stub, + N_Protected_Body_Stub, + N_Subunit, + N_Exception_Declaration, + N_Handled_Sequence_Of_Statements, + N_Exception_Handler, + N_Raise_Statement, + N_Raise_Expression, + N_Generic_Subprogram_Declaration, + N_Generic_Package_Declaration, + N_Package_Instantiation, + N_Procedure_Instantiation, + N_Function_Instantiation, + N_Generic_Association, + N_Formal_Object_Declaration, + N_Formal_Type_Declaration, + N_Formal_Private_Type_Definition, + N_Formal_Derived_Type_Definition, + N_Formal_Incomplete_Type_Definition, + N_Formal_Discrete_Type_Definition, + N_Formal_Signed_Integer_Type_Definition, + N_Formal_Modular_Type_Definition, + N_Formal_Floating_Point_Definition, + N_Formal_Ordinary_Fixed_Point_Definition, + N_Formal_Decimal_Fixed_Point_Definition, + N_Formal_Concrete_Subprogram_Declaration, + N_Formal_Abstract_Subprogram_Declaration, + N_Formal_Package_Declaration, + N_Attribute_Definition_Clause, + N_Aspect_Specification, + N_Enumeration_Representation_Clause, + N_Record_Representation_Clause, + N_Component_Clause, + N_Code_Statement, + N_Op_Rotate_Left, + N_Op_Rotate_Right, + N_Op_Shift_Left, + N_Op_Shift_Right_Arithmetic, + N_Op_Shift_Right, + N_Delta_Constraint, + N_At_Clause, + N_Mod_Clause, + N_Call_Marker, + N_Compound_Statement, + N_Contract, + N_Expanded_Name, + N_Expression_With_Actions, + N_Free_Statement, + N_Freeze_Entity, + N_Freeze_Generic_Entity, + N_Implicit_Label_Declaration, + N_Itype_Reference, + N_Raise_Constraint_Error, + N_Raise_Program_Error, + N_Raise_Storage_Error, + N_Push_Constraint_Error_Label, + N_Push_Program_Error_Label, + N_Push_Storage_Error_Label, + N_Pop_Constraint_Error_Label, + N_Pop_Program_Error_Label, + N_Pop_Storage_Error_Label, + N_Reference, + N_SCIL_Dispatch_Table_Tag_Init, + N_SCIL_Dispatching_Call, + N_SCIL_Membership_Test, + N_Unchecked_Expression, + N_Unchecked_Type_Conversion, + N_Validate_Unchecked_Conversion, + N_Variable_Reference_Marker); + +end Gen_IL.Utils; diff --git a/gcc/ada/gen_il.adb b/gcc/ada/gen_il.adb new file mode 100644 index 00000000000..1a6326daa6c --- /dev/null +++ b/gcc/ada/gen_il.adb @@ -0,0 +1,63 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L -- +-- -- +-- 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. -- +-- -- +------------------------------------------------------------------------------ + +package body Gen_IL is + + function Image (X : Root_Int) return String is + Result : constant String := X'Img; + begin + if Result (1) = ' ' then + return Result (2 .. Result'Last); + else + return Result; + end if; + end Image; + + procedure Capitalize (S : in out String) is + Cap : Boolean := True; + begin + for X of S loop + declare + Old : constant Character := X; + begin + if Cap then + X := To_Upper (X); + else + X := To_Lower (X); + end if; + + Cap := not (Is_Letter (Old) or else Is_Digit (Old)); + end; + end loop; + end Capitalize; + + function Capitalize (S : String) return String is + begin + return Result : String (S'Range) := S do + Capitalize (Result); + end return; + end Capitalize; + +end Gen_IL; diff --git a/gcc/ada/gen_il.ads b/gcc/ada/gen_il.ads new file mode 100644 index 00000000000..3b0e4ba9af1 --- /dev/null +++ b/gcc/ada/gen_il.ads @@ -0,0 +1,309 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G E N _ I L -- +-- -- +-- 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. 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. -- +-- -- +------------------------------------------------------------------------------ + +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; +pragma Warnings (On); + +package Gen_IL is -- generate intermediate language + + -- This package and children generates the main intermediate language used + -- by the compiler, which is a decorated syntax tree. + + -- Here's what the hand-written and generated code looks like. The make + -- files run the gen_il-main.adb program to generate the generated files + -- listed below, before building the compiler proper. + -- + -- atree.ads, atree.adb: Rewrite according to low-level + -- design notes. Remove package Unchecked_Access. + -- Low-level getters and setters go in Atree_Private_Part. + -- These are called by the high-level automatically-generated + -- getters and setters in Sinfo.Nodes and Einfo.Entities. + -- Also used by Atree.Traverse_Func, and by Treepr. + -- + -- sinfo.ads, einfo.ads: Remove getters and setters. + -- Remove Write_... routines used by old Treepr. + -- Keep commments describing the semantics of all the nodes, + -- entities, and fields. These comments are wrong, but only + -- a little, and I'm not going to try to fix them. At some + -- point, we could remove the comments giving field offsets + -- (e.g. "(Flag5-Sem)"), but for now, just note that that's + -- obsolete info. + -- + -- einfo.adb, sinfo.adb: Delete. + -- + -- gen_il.ads, gen_il.adb: Mostly empty root package for the + -- "generate intermediate language" program, which generates + -- all the files mentioned here. + -- The main program is gen_il-main.adb. + -- + -- sinfo-utils.ads, sinfo-utils.adb, einfo-utils.ads, einfo-utils.adb: + -- Move all handwritten code currently in sinfo&einfo to here, + -- if it refers to stuff in sinfo-nodes.ads, einfo-entities.ads + -- This includes the "synthesized attributes". + -- + -- gen_il-types.ads: Enumeration type containing one literal for + -- each type of interest. That includes all the Node_Kinds and + -- Entity_Kinds, plus the subtypes that include multiple + -- Node_Kinds and Entity_Kinds (all from the old sinfo/einfo), + -- plus all field types (Uint, Ureal, Name_Id, etc). + -- + -- gen_il-fields.ads: Enumeration of all the fields of all node + -- and entity types. + -- + -- gen_il-gen.ads, gen_il-gen.adb: Implementation of the "compiler" + -- for the "little language". + -- + -- gen_il-gen-gen_nodes.adb: Procedure to generate Sinfo.Nodes + -- (by calling procedures in Gen_IL). + -- This defines what abstract and concrete node types exist, + -- and what fields they have. This and the next one are the + -- hard part. I'm planning to generate this semi-automatically. + -- But once it's working, we will maintain it by hand. + -- + -- gen_il-gen-gen_entities.adb: Procedure to generate einfo-entities.*. + -- This defines what abstract and concrete entity types exist, + -- and what fields they have. + -- + -- seinfo.ads: Generated by gen_il-main.adb. Contains declarations shared + -- by Sinfo.Nodes and Einfo.Entities. + -- + -- sinfo-nodes.ads, sinfo-nodes.adb: Generated by gen_il-main.adb + -- (really by Gen_Nodes). Contains: + -- + -- - Information in comments, such as what fields exist in what + -- node kinds, which might be hard to compute by hand for + -- inherited fields. + -- + -- - Type Node_Kind. Same as the old Sinfo, but now generated. + -- One enumeral for each concrete node type in Gen_Nodes. + -- + -- - One subtype of Node_Kind for each abstract type in Gen_Nodes. + -- Same as the old Sinfo, but now generated. E.g.: + -- + -- subtype N_Representation_Clause is Node_Kind range + -- N_At_Clause .. N_Attribute_Definition_Clause; + -- + -- - One subtype of Node_Id for each abstract and concrete type, + -- with a predicate requiring the right Nkind. E.g.: + -- + -- subtype N_Representation_Clause_Id is + -- Node_Id with Predicate => + -- Nkind (N_Representation_Clause_Id) in N_Representation_Clause; + -- + -- - Getters and setters for every node field. If the field is defined + -- for all node kinds in one of the above Node_Id subtypes and no + -- others, then we use that as the parameter subtype: + -- + -- function Abortable_Part + -- (N : N_Asynchronous_Select_Id) return Node_Id with Inline; + -- + -- Otherwise, we use a precondition: + -- + -- function Abstract_Present + -- (N : Node_Id) return Flag with Inline, Pre => + -- N in N_Private_Extension_Declaration_Id + -- | N_Private_Type_Declaration_Id + -- | N_Derived_Type_Definition_Id + -- ... + -- + -- - Type Node_Field: Enumeration of all node fields. Used by Treepr, + -- and in tables below. + -- + -- - Table of syntactic fields. For each node kind, we have a sequence + -- of fields. A field is included if it exists in that node kind, + -- and it is syntactic, and it is of type Node_Id or List_Id. + -- Used by Traverse_Func. + -- + -- - Table of node sizes, indexed by Node_Kind. Used by Atree when + -- allocating and copying nodes. + -- + -- - Table mapping Node_Kinds to the sequence of fields that exist in + -- that Node_Kind. Used by Treepr. + -- + -- - Node_Field_Descriptors: Table mapping fields to type and offset. + -- Used by Treepr to know where to find each field, and what its + -- type is, for printing. + -- + -- - The body contains instantiations of the low-level getters and + -- setters declared in Atree, e.g.: + -- + -- function Get_List_Id is new Get_32_Bit_Field (List_Id) + -- with Inline; + -- procedure Set_List_Id is new Set_32_Bit_Field (List_Id) + -- with Inline; + -- + -- and bodies of the high-level getters and setters, e.g.: + -- + -- function Actions + -- (N : Node_Id) return List_Id is + -- begin + -- return Get_List_Id (N, 4); + -- end Actions; + -- + -- einfo-entities.ads, einfo-entities.adb: Generated by gen_il-main.adb + -- (really by Gen_Entities). Contains the same sort of stuff as + -- Sinfo.Nodes, except no table of syntactic fields. + -- + -- nmake.ads, nmake.adb: Same contents as the old version, but generated by + -- Gen_IL instead of xnmake. + -- + -- treepr.adb: Rewrite to use the tables in Nodes and Entities. + -- + -- treeprs.ads: Delete. (Was automatically generated.) + -- Treepr no longer needs this; it can use 'Image on the + -- enumeration types in Nodes and Entities. + -- + -- csinfo.adb, ceinfo.adb, xsinfo.adb, xeinfo.adb, xnmake.adb, + -- xtreeprs.adb, nmake.adt, treeprs.adt: Delete. + + -- C++ code: + -- + -- atree.h (hand-written code): + -- + -- This code should be entirely deleted, and replaced with low-level + -- getters analogous to the generic getters in Atree. One getter for each + -- field size (currently 1, 2, 4, 8, and 32 bits. No need for setters. + -- + -- ---------------- + -- + -- fe.h (hand-written code): + -- + -- There are comments in various places that say that gigi + -- does not modify the tree. However, I discovered some stuff + -- in fe.h that modifies the tree: + -- + -- #define End_Location sinfo__end_location + -- #define Set_Has_No_Elaboration_Code sinfo__set_has_no_elaboration_code + -- #define Set_Present_Expr sinfo__set_present_expr + -- + -- #define Set_Alignment einfo__set_alignment + -- #define Set_Component_Bit_Offset einfo__set_component_bit_offset + -- #define Set_Component_Size einfo__set_component_size + -- #define Set_Esize einfo__set_esize + -- #define Set_Mechanism einfo__set_mechanism + -- #define Set_Normalized_First_Bit einfo__set_normalized_first_bit + -- #define Set_Normalized_Position einfo__set_normalized_position + -- #define Set_RM_Size einfo__set_rm_size + -- + -- #define Is_Entity_Name einfo__utils__is_entity_name + -- #define Get_Attribute_Definition_Clause \ + -- einfo__utils__get_attribute_definition_clause + -- + -- These setters and some getters need to be changed because the + -- setters and getters are moving from Sinfo to Sinfo.Nodes, + -- and from Einfo to Einfo.Entities. The last two will be in Einfo.Utils. + -- + -- ---------------- + -- + -- sinfo.h (tool-generated code): + -- + -- A bunch of #defines for the node kinds. These can remain the same. + -- + -- A bunch of calls to SUBTYPE (macro defined in gcc-interface/ada.h). + -- These can remain the same. + -- + -- A bunch of getters (no setters), like: + -- + -- INLINE Boolean Abort_Present (Node_Id N) + -- { return Flag15 (N); } + -- + -- Change this to call the new low-level getters. + -- Something like: + -- + -- INLINE Boolean Abort_Present (Node_Id N) + -- { return Get_Flag (N, 15); } + -- + -- Generate the low-level getters in the same file, before the above + -- high-level getters, one for each field type: + -- + -- Flag + -- Node_Id + -- List_Id + -- Elist_Id + -- Name_Id + -- String_Id + -- Uint + -- Ureal + -- Node_Kind + -- Entity_Kind + -- Source_Ptr + -- Small_Paren_Count_Type + -- Union_Id + -- Convention_Id + -- Component_Alignment_Kind + -- Float_Rep_Kind + -- Mechanism_Type + -- + -- These are in types.h. + -- + -- ---------------- + -- + -- einfo.h (tool-generated code): + -- + -- Can mostly remain the same, except: + -- + -- Call low-level getters, as for sinfo.h. + -- + -- The getters that are NOT inlined will be moved from + -- Einfo to Einfo.Entities. + -- I don't understand why some are not inlined (e.g Float_Rep?). + -- Most are not inlined because they are synthesized. + -- Maybe that should be hand written, and moved to a different file. + -- Or maybe Gen_IL should know about these fields. + -- + -- We have code like: + -- INLINE B Is_Subprogram_Or_Generic_Subprogram (E Id) + -- { return IN (Ekind (Id), Subprogram_Kind) || IN (Ekind (Id), + -- Generic_Subprogram_Kind); } + -- That should be hand written, and moved to atree.h or fe.h. + -- Is_Record_Type requires special treatment, because Record_Kind is + -- a nonhierarchical type. + -- + -- Looks like the getters are in alphabetical order. + -- Except for the Is_..._Type ones. + + -- Misc declarations used throughout: + + type Root_Int is new Integer; + function Image (X : Root_Int) return String; + -- Without the extra blank. You can derive from Root_Int or the subtypes + -- below, and inherit a convenient Image function that leaves out that + -- blank. + + subtype Root_Nat is Root_Int range 0 .. Root_Int'Last; + subtype Root_Pos is Root_Int range 1 .. Root_Int'Last; + + function Capitalize (S : String) return String; + procedure Capitalize (S : in out String); + -- Turns an identifier into Mixed_Case + + type String_Ptr is access all String; + +end Gen_IL; diff --git a/gcc/ada/get_targ.ads b/gcc/ada/get_targ.ads index 4670b5bce05..1928273a707 100644 --- a/gcc/ada/get_targ.ads +++ b/gcc/ada/get_targ.ads @@ -37,7 +37,6 @@ -- the Wide_Character_Type uses twice the size of a C char, instead of the -- size of wchar_t. -with Einfo; use Einfo; with Types; use Types; package Get_Targ is diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 8ec889d992b..0a78fad2c07 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -26,7 +26,9 @@ with Alloc; with Aspects; use Aspects; with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Namet; use Namet; @@ -39,7 +41,9 @@ with Sem_Eval; use Sem_Eval; with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Table; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index cefc5c6a1c7..31d0018e1f0 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -65,7 +65,9 @@ with Sem_Eval; with Sem_Prag; with Sem_Type; with Set_Targ; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Sinput.L; use Sinput.L; with Snames; use Snames; @@ -610,12 +612,6 @@ procedure Gnat1drv is Ttypes.Target_Strict_Alignment := True; end if; - -- Increase size of allocated entities if debug flag -gnatd.N is set - - if Debug_Flag_Dot_NN then - Atree.Num_Extension_Nodes := Atree.Num_Extension_Nodes + 1; - end if; - -- Disable static allocation of dispatch tables if -gnatd.t is enabled. -- The front end's layout phase currently treats types that have -- discriminant-dependent arrays as not being static even when a @@ -1093,10 +1089,6 @@ begin -- Lib.Initialize needs to be called before Scan_Compiler_Arguments, -- because it initializes a table filled by Scan_Compiler_Arguments. - -- Atree.Initialize needs to be called after Scan_Compiler_Arguments, - -- because the value specified by the -gnaten switch is used by - -- Atree.Initialize. - Osint.Initialize; Fmap.Reset_Tables; Lib.Initialize; @@ -1720,10 +1712,6 @@ begin <<End_Of_Program>> - if Debug_Flag_Dot_AA then - Atree.Print_Statistics; - end if; - -- The outer exception handler handles an unrecoverable error exception diff --git a/gcc/ada/gnat_cuda.adb b/gcc/ada/gnat_cuda.adb index 7c06f25a7e9..eb023dbe3ab 100644 --- a/gcc/ada/gnat_cuda.adb +++ b/gcc/ada/gnat_cuda.adb @@ -25,14 +25,14 @@ -- This package defines CUDA-specific datastructures and functions. -with Atree; use Atree; with Debug; use Debug; with Elists; use Elists; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; with Rtsfind; use Rtsfind; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Stringt; use Stringt; with Tbuild; use Tbuild; with Uintp; use Uintp; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 06886ba62ad..a5ba1b1b5c8 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -23,9 +23,9 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; with Errout; use Errout; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Fname.UF; use Fname.UF; with Lib; use Lib; with Namet; use Namet; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 91a8bf24bc4..4bd7ea10c7b 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -27,7 +27,9 @@ with Alloc; with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; @@ -49,7 +51,9 @@ with Sem_Ch12; use Sem_Ch12; with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/itypes.adb b/gcc/ada/itypes.adb index 4732c628eee..e9e851aeb28 100644 --- a/gcc/ada/itypes.adb +++ b/gcc/ada/itypes.adb @@ -23,9 +23,10 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; +with Einfo.Utils; use Einfo.Utils; with Sem; use Sem; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Stand; use Stand; with Targparm; use Targparm; with Uintp; use Uintp; diff --git a/gcc/ada/itypes.ads b/gcc/ada/itypes.ads index 421a035af47..8188ca88611 100644 --- a/gcc/ada/itypes.ads +++ b/gcc/ada/itypes.ads @@ -25,7 +25,8 @@ -- This package contains declarations for handling of implicit types -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with Sem_Util; use Sem_Util; with Types; use Types; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 42f29d7bb7d..1b9d9eea30a 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -25,14 +25,18 @@ with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Opt; use Opt; with Sem_Aux; use Sem_Aux; with Sem_Ch13; use Sem_Ch13; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Ttypes; use Ttypes; with Uintp; use Uintp; diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index f561b6db0bc..991496e939c 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -25,7 +25,8 @@ with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with Errout; use Errout; with Fname; use Fname; with Fname.UF; use Fname.UF; @@ -38,7 +39,9 @@ with Output; use Output; with Par; with Restrict; use Restrict; with Scn; use Scn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Sinput.L; use Sinput.L; with Stand; use Stand; diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 8f6b465b4b6..38c9fd6d603 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -27,7 +27,9 @@ with ALI; use ALI; with Atree; use Atree; with Casing; use Casing; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Fname; use Fname; with Fname.UF; use Fname.UF; @@ -46,7 +48,9 @@ with Rident; use Rident; with Stand; use Stand; with Scn; use Scn; with Sem_Eval; use Sem_Eval; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stringt; use Stringt; diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index 74afe42cc7e..a56e005440f 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -23,7 +23,7 @@ -- -- ------------------------------------------------------------------------------ -with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with Nmake; use Nmake; with SPARK_Xrefs; use SPARK_Xrefs; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index f8d86e6b921..2bd311c21c3 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -25,6 +25,8 @@ with Atree; use Atree; with Csets; use Csets; +with Einfo; use Einfo; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Lib.Util; use Lib.Util; @@ -37,7 +39,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stringt; use Stringt; diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 617579ac2f8..55a92515740 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -26,7 +26,7 @@ -- This package contains for collecting and outputting cross-reference -- information. -with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with SPARK_Xrefs; package Lib.Xref is diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index f347b8cae2d..9998ba0459e 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -29,11 +29,13 @@ pragma Style_Checks (All_Checks); with Atree; use Atree; with Csets; use Csets; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with Nlists; use Nlists; with Opt; use Opt; with Output; use Output; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Sinput; use Sinput; with Stand; use Stand; with Stringt; use Stringt; diff --git a/gcc/ada/libgnat/a-stobfi.adb b/gcc/ada/libgnat/a-stobfi.adb index e3fcdcc51d8..942f1518229 100644 --- a/gcc/ada/libgnat/a-stobfi.adb +++ b/gcc/ada/libgnat/a-stobfi.adb @@ -62,7 +62,7 @@ package body Ada.Strings.Text_Output.Basic_Files is is begin return Create_From_FD - (OS.Create_File (Name, Fmode => OS.Text), + (OS.Create_File (Name, Fmode => OS.Binary), Indent_Amount, Chunk_Length); end Create_File; @@ -73,7 +73,7 @@ package body Ada.Strings.Text_Output.Basic_Files is is begin return Create_From_FD - (OS.Create_New_File (Name, Fmode => OS.Text), + (OS.Create_New_File (Name, Fmode => OS.Binary), Indent_Amount, Chunk_Length); end Create_New_File; diff --git a/gcc/ada/libgnat/a-stoubu.adb b/gcc/ada/libgnat/a-stoubu.adb index 13a3ec6e198..3c5433866a1 100644 --- a/gcc/ada/libgnat/a-stoubu.adb +++ b/gcc/ada/libgnat/a-stoubu.adb @@ -78,7 +78,7 @@ package body Ada.Strings.Text_Output.Buffers is S.Cur_Chunk.Next := Text_Output.Chunk_Access (Chunk_Access'(new Chunk (S.Chunk_Length))); S.Cur_Chunk := S.Cur_Chunk.Next; - S.Num_Extra_Chunks := @ + 1; + S.Num_Extra_Chunks := S.Num_Extra_Chunks + 1; S.Last := 0; end Full_Method; diff --git a/gcc/ada/libgnat/a-stoufi.adb b/gcc/ada/libgnat/a-stoufi.adb index 3e01537187f..3444e3b47d9 100644 --- a/gcc/ada/libgnat/a-stoufi.adb +++ b/gcc/ada/libgnat/a-stoufi.adb @@ -46,7 +46,7 @@ package body Ada.Strings.Text_Output.Files is is begin if FD = OS.Invalid_FD then - raise Program_Error with OS.Errno_Message; + raise Program_Error; end if; return Result : File (Chunk_Length) do Result.Indent_Amount := Indent_Amount; @@ -62,7 +62,7 @@ package body Ada.Strings.Text_Output.Files is is begin return Create_From_FD - (OS.Create_File (Name, Fmode => OS.Text), + (OS.Create_File (Name, Fmode => OS.Binary), Indent_Amount, Chunk_Length); end Create_File; @@ -73,7 +73,7 @@ package body Ada.Strings.Text_Output.Files is is begin return Create_From_FD - (OS.Create_New_File (Name, Fmode => OS.Text), + (OS.Create_New_File (Name, Fmode => OS.Binary), Indent_Amount, Chunk_Length); end Create_New_File; @@ -90,7 +90,7 @@ package body Ada.Strings.Text_Output.Files is if S.FD not in OS.Standout | OS.Standerr then -- Don't close these OS.Close (S.FD, Status); if not Status then - raise Program_Error with OS.Errno_Message; + raise Program_Error; end if; end if; end Close; @@ -103,7 +103,7 @@ package body Ada.Strings.Text_Output.Files is OS.Write (S.FD, S.Cur_Chunk.Chars'Address, S.Last); begin if Res /= S.Last then - raise Program_Error with OS.Errno_Message; + raise Program_Error; end if; S.Last := 0; end Flush_Method; diff --git a/gcc/ada/libgnat/a-stouut.adb b/gcc/ada/libgnat/a-stouut.adb index 75bcf0ad0d7..6b8f72ba84d 100644 --- a/gcc/ada/libgnat/a-stouut.adb +++ b/gcc/ada/libgnat/a-stouut.adb @@ -57,7 +57,7 @@ package body Ada.Strings.Text_Output.Utils is procedure Put_Octet (S : in out Sink'Class; Item : Character) is begin - S.Last := @ + 1; + S.Last := S.Last + 1; S.Cur_Chunk.Chars (S.Last) := Item; pragma Assert (S.Chunk_Length = S.Cur_Chunk.Chars'Length); if S.Last = S.Chunk_Length then @@ -75,7 +75,7 @@ package body Ada.Strings.Text_Output.Utils is if S.Column = 1 then Tab_To_Column (S, S.Indentation + 1); end if; - S.Column := @ + 1; + S.Column := S.Column + 1; end Adjust_Column; procedure Put_7bit (S : in out Sink'Class; Item : Character_7) is @@ -196,7 +196,7 @@ package body Ada.Strings.Text_Output.Utils is Line_Start := Index + 1; end if; - Index := @ + 1; + Index := Index + 1; end loop; if Index > Line_Start then diff --git a/gcc/ada/libgnat/a-stteou__bootstrap.ads b/gcc/ada/libgnat/a-stteou__bootstrap.ads new file mode 100644 index 00000000000..0112491d0fa --- /dev/null +++ b/gcc/ada/libgnat/a-stteou__bootstrap.ads @@ -0,0 +1,190 @@ +------------------------------------------------------------------------------ +-- -- +-- 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/live.adb b/gcc/ada/live.adb index 91ea7bbe8e5..a97b3ac8736 100644 --- a/gcc/ada/live.adb +++ b/gcc/ada/live.adb @@ -24,12 +24,16 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Lib; use Lib; with Nlists; use Nlists; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Types; use Types; package body Live is diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb index aa67a6a2966..b20b6a487f4 100644 --- a/gcc/ada/nlists.adb +++ b/gcc/ada/nlists.adb @@ -30,7 +30,8 @@ with Alloc; with Atree; use Atree; with Debug; use Debug; with Output; use Output; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Table; package body Nlists is @@ -39,9 +40,6 @@ package body Nlists is -- permitted only when this switch is set to False; compiling without -- assertions this lock has no effect. - use Atree_Private_Part; - -- Get access to Nodes table - ---------------------------------- -- Implementation of Node Lists -- ---------------------------------- @@ -86,17 +84,16 @@ package body Nlists is Table_Component_Type => Node_Or_Entity_Id, Table_Index_Type => Node_Or_Entity_Id'Base, Table_Low_Bound => First_Node_Id, - Table_Initial => Alloc.Nodes_Initial, - Table_Increment => Alloc.Nodes_Increment, - Release_Threshold => Alloc.Nodes_Release_Threshold, + Table_Initial => Alloc.Node_Offsets_Initial, + Table_Increment => Alloc.Node_Offsets_Increment, Table_Name => "Next_Node"); package Prev_Node is new Table.Table ( Table_Component_Type => Node_Or_Entity_Id, Table_Index_Type => Node_Or_Entity_Id'Base, Table_Low_Bound => First_Node_Id, - Table_Initial => Alloc.Nodes_Initial, - Table_Increment => Alloc.Nodes_Increment, + Table_Initial => Alloc.Node_Offsets_Initial, + Table_Increment => Alloc.Node_Offsets_Increment, Table_Name => "Prev_Node"); ----------------------- @@ -188,7 +185,7 @@ package body Nlists is Set_Last (To, Node); - Nodes.Table (Node).In_List := True; + Set_In_List (Node, True); Set_Next (Node, Empty); Set_Prev (Node, L); @@ -406,7 +403,7 @@ package body Nlists is Set_Next (After, Node); - Nodes.Table (Node).In_List := True; + Set_In_List (Node, True); Set_Prev (Node, After); Set_Next (Node, Before); @@ -466,7 +463,7 @@ package body Nlists is Set_Prev (Before, Node); - Nodes.Table (Node).In_List := True; + Set_In_List (Node, True); Set_Prev (Node, After); Set_Next (Node, Before); @@ -623,7 +620,7 @@ package body Nlists is function Is_List_Member (Node : Node_Or_Entity_Id) return Boolean is begin - return Nodes.Table (Node).In_List; + return In_List (Node); end Is_List_Member; ----------------------- @@ -675,7 +672,7 @@ package body Nlists is function List_Containing (Node : Node_Or_Entity_Id) return List_Id is begin pragma Assert (Is_List_Member (Node)); - return List_Id (Nodes.Table (Node).Link); + return List_Id (Link (Node)); end List_Containing; ----------------- @@ -866,7 +863,7 @@ package body Nlists is Set_First (List, Node); Set_Last (List, Node); - Nodes.Table (Node).In_List := True; + Set_In_List (Node, True); Set_List_Link (Node, List); Set_Prev (Node, Empty); Set_Next (Node, Empty); @@ -1083,7 +1080,7 @@ package body Nlists is Set_First (To, Node); - Nodes.Table (Node).In_List := True; + Set_In_List (Node, True); Set_Next (Node, F); Set_Prev (Node, Empty); @@ -1292,7 +1289,7 @@ package body Nlists is Set_Prev (Nxt, Prv); end if; - Nodes.Table (Node).In_List := False; + Set_In_List (Node, False); Set_Parent (Node, Empty); end Remove; @@ -1341,7 +1338,7 @@ package body Nlists is Set_Prev (Nxt, Empty); end if; - Nodes.Table (Frst).In_List := False; + Set_In_List (Frst, False); Set_Parent (Frst, Empty); return Frst; end; @@ -1392,7 +1389,7 @@ package body Nlists is Set_Prev (Nxt2, Node); end if; - Nodes.Table (Nxt).In_List := False; + Set_In_List (Nxt, False); Set_Parent (Nxt, Empty); end; end if; @@ -1427,7 +1424,7 @@ package body Nlists is procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id) is begin pragma Assert (not Locked); - Nodes.Table (Node).Link := Union_Id (To); + Set_Link (Node, Union_Id (To)); end Set_List_Link; -------------- diff --git a/gcc/ada/nlists.h b/gcc/ada/nlists.h index e68ff6abf5a..2cd5cf3d596 100644 --- a/gcc/ada/nlists.h +++ b/gcc/ada/nlists.h @@ -105,9 +105,6 @@ Prev (Node_Id Node) extern Node_Id Prev_Non_Pragma (Node_Id); static Boolean Is_Empty_List (List_Id); -static Boolean Is_Non_Empty_List (List_Id); -static Boolean Is_List_Member (Node_Id); -static List_Id List_Containing (Node_Id); INLINE Boolean Is_Empty_List (List_Id Id) @@ -115,24 +112,6 @@ Is_Empty_List (List_Id Id) return (First (Id) == Empty); } -INLINE Boolean -Is_Non_Empty_List (List_Id Id) -{ - return (Present (Id) && First (Id) != Empty); -} - -INLINE Boolean -Is_List_Member (Node_Id Node) -{ - return Nodes_Ptr[Node - First_Node_Id].U.K.in_list; -} - -INLINE List_Id -List_Containing (Node_Id Node) -{ - return Nodes_Ptr[Node - First_Node_Id].V.NX.link; -} - #ifdef __cplusplus } #endif diff --git a/gcc/ada/nmake.adt b/gcc/ada/nmake.adt deleted file mode 100644 index 8fd56841457..00000000000 --- a/gcc/ada/nmake.adt +++ /dev/null @@ -1,80 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- N M A K E -- --- -- --- T e m p l a t e -- --- -- --- Copyright (C) 1992-2007, 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. -- --- -- ------------------------------------------------------------------------------- --- This file is a template used as input to the utility program XNmake, --- which reads this template, and the spec of Sinfo (sinfo.ads) and --- generates the body and/or the spec for the Nmake package (files --- nmake.ads and nmake.adb) - -pragma Style_Checks (All_Checks); --- Turn off subprogram order checking, since the routines here are --- generated automatically in order. - -with Atree; use Atree; -- body only -with Namet; use Namet; -- spec only -with Nlists; use Nlists; -- spec only -with Sinfo; use Sinfo; -- body only -with Snames; use Snames; -- body only -with Stand; use Stand; -- body only -with Types; use Types; -- spec only -with Uintp; use Uintp; -- spec only -with Urealp; use Urealp; -- spec only - -package Nmake is - --- This package contains a set of routines used to construct tree nodes --- using a functional style. There is one routine for each node type defined --- in Sinfo with the general interface: - --- function Make_xxx (Sloc : Source_Ptr, --- Field_Name_1 : Field_Name_1_Type [:= default] --- Field_Name_2 : Field_Name_2_Type [:= default] --- ...) --- return Node_Id - --- Only syntactic fields are included (i.e. fields marked as "-Sem" or "-Lib" --- in the Sinfo spec are excluded). In addition, the following four syntactic --- fields are excluded: - --- Prev_Ids --- More_Ids --- Comes_From_Source --- Paren_Count - --- since they are very rarely set in expanded code. If they need to be set, --- to other than the default values (False, False, False, zero), then the --- appropriate Set_xxx procedures must be used on the returned value. - --- Default values are provided only for flag fields (where the default is --- False), and for optional fields. An optional field is one where the --- comment line describing the field contains the string "(set to xxx if". --- For such fields, a default value of xxx is provided." - --- Warning: since calls to Make_xxx routines are normal function calls, the --- arguments can be evaluated in any order. This means that at most one such --- argument can have side effects (e.g. be a call to a parse routine). - -!!TEMPLATE INSERTION POINT - -end Nmake; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index aeac35204ad..e4be0961d2e 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1528,7 +1528,7 @@ package Opt is Table_Factor : Int := 1; -- GNAT -- Factor by which all initial table sizes set in Alloc are multiplied. - -- Used in Table to calculate initial table sizes (the initial table size + -- Used in Table to calculate initial table sizes. The initial table size -- is the value in Alloc, used as the Table_Initial parameter value, -- multiplied by the factor given here. The default value is used if no -- -gnatT switch appears. diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 86d0bb22218..b026979868c 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -44,7 +44,9 @@ with Scn; use Scn; with Sem_Util; use Sem_Util; with Sinput; use Sinput; with Sinput.L; use Sinput.L; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Style; with Stylesw; use Stylesw; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 8dc73d34df2..16942144168 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -37,7 +37,9 @@ with Put_SCOs; with SCOs; use SCOs; with Sem; use Sem; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Table; diff --git a/gcc/ada/pprint.adb b/gcc/ada/pprint.adb index e3e26e8dce3..e6a7cc38f30 100644 --- a/gcc/ada/pprint.adb +++ b/gcc/ada/pprint.adb @@ -24,11 +24,15 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Uintp; use Uintp; diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 4e155cf6bbc..54dbb320343 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -27,7 +27,9 @@ with Alloc; with Atree; use Atree; with Casing; use Casing; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; @@ -35,7 +37,9 @@ with Opt; use Opt; with Output; use Output; with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stringt; use Stringt; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index b4778a38080..31ba422fed9 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -25,14 +25,18 @@ with Atree; use Atree; with Casing; use Casing; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Debug; use Debug; with Fname; use Fname; with Fname.UF; use Fname.UF; with Lib; use Lib; with Opt; use Opt; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Stand; use Stand; with Targparm; use Targparm; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 33ce7cdfeab..11aad690a8a 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -27,7 +27,9 @@ with Atree; use Atree; with Casing; use Casing; with Csets; use Csets; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Dist; @@ -47,7 +49,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Ch7; use Sem_Ch7; with Sem_Dist; use Sem_Dist; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Stand; use Stand; with Snames; use Snames; with Tbuild; use Tbuild; diff --git a/gcc/ada/scil_ll.adb b/gcc/ada/scil_ll.adb index 21614ec2908..4e8c9dfb6b2 100644 --- a/gcc/ada/scil_ll.adb +++ b/gcc/ada/scil_ll.adb @@ -25,7 +25,8 @@ with Atree; use Atree; with Opt; use Opt; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with System.HTable; use System.HTable; package body SCIL_LL is diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index 9c62f20ac76..d0d49899c70 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -30,7 +30,8 @@ with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; with Scans; use Scans; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Sinput; use Sinput; with Uintp; use Uintp; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 88b791023c4..1c001b08521 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -26,6 +26,9 @@ with Atree; use Atree; with Debug; use Debug; with Debug_A; use Debug_A; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_SPARK; use Exp_SPARK; with Expander; use Expander; @@ -50,7 +53,9 @@ with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Stand; use Stand; with Stylesw; use Stylesw; with Uintp; use Uintp; diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 318e2417163..a56ce937b91 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -202,7 +202,6 @@ -- called Preanalyze_And_Resolve and is in Sem_Res. with Alloc; -with Einfo; use Einfo; with Opt; use Opt; with Table; with Types; use Types; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index ef9566713fe..123f9dbc48c 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -26,7 +26,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; @@ -57,7 +59,9 @@ with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sem_Type; use Sem_Type; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stringt; use Stringt; with Stand; use Stand; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6fe491c7895..19c5d4605cd 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -30,7 +30,9 @@ with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Eval_Fat; @@ -66,7 +68,9 @@ with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with System; with Stringt; use Stringt; @@ -11477,14 +11481,14 @@ package body Sem_Attr is ("access to atomic object cannot yield access-to-" & "non-atomic type", P); - elsif Is_Volatile_Object (P) + elsif Is_Volatile_Object_Ref (P) and then not Is_Volatile (Designated_Type (Typ)) then Error_Msg_F ("access to volatile object cannot yield access-to-" & "non-volatile type", P); - elsif Is_Volatile_Full_Access_Object (P) + elsif Is_Volatile_Full_Access_Object_Ref (P) and then not Is_Volatile_Full_Access (Designated_Type (Typ)) then Error_Msg_F diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 46b1b4cf0df..8f645a7e9bc 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -24,9 +24,13 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Nlists; use Nlists; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Uintp; use Uintp; diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index f4a0716a7e9..136c7195f1c 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Namet; use Namet; with Nlists; use Nlists; @@ -38,7 +40,9 @@ with Sem_Util; use Sem_Util; with Sem_Type; use Sem_Type; with Snames; use Snames; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Tbuild; use Tbuild; with Uintp; use Uintp; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index b35c364ec63..5a2b1ccade6 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Lib; use Lib; @@ -38,7 +40,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Dist; use Sem_Dist; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 22519ef3a15..c1b92537b56 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Contracts; use Contracts; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Exp_Put_Image; with Exp_Util; use Exp_Util; @@ -61,7 +63,9 @@ with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinfo.CN; use Sinfo.CN; with Sinput; use Sinput; with Snames; use Snames; @@ -2433,8 +2437,10 @@ package body Sem_Ch10 is -- The syntax rules require a proper body for a subprogram subunit - if Nkind (Proper_Body (Sinfo.Unit (N))) = N_Subprogram_Declaration then - if Null_Present (Specification (Proper_Body (Sinfo.Unit (N)))) then + if Nkind (Proper_Body (Sinfo.Nodes.Unit (N))) = N_Subprogram_Declaration + then + if Null_Present (Specification (Proper_Body (Sinfo.Nodes.Unit (N)))) + then Error_Msg_N ("null procedure not allowed as subunit", Proper_Body (Unit (N))); diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index ffe5f745671..c250ed2ed4f 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Checks; use Checks; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Lib; use Lib; with Lib.Xref; use Lib.Xref; @@ -44,7 +46,9 @@ with Sem_Ch13; use Sem_Ch13; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index a0f1c11b26f..5303fb0d027 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -26,7 +26,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Contracts; use Contracts; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; @@ -65,7 +67,9 @@ with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinfo.CN; use Sinfo.CN; with Sinput; use Sinput; with Sinput.L; use Sinput.L; @@ -7872,16 +7876,10 @@ package body Sem_Ch12 is ---------------------- procedure Copy_Descendants is - use Atree.Unchecked_Access; - -- This code section is part of the implementation of an untyped - -- tree traversal, so it needs direct access to node fields. - + procedure Walk is new + Walk_Sinfo_Fields_Pairwise (Copy_Generic_Descendant); begin - Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N))); - Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N))); - Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N))); - Set_Field4 (New_N, Copy_Generic_Descendant (Field4 (N))); - Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N))); + Walk (New_N, N); end Copy_Descendants; ----------------------------- @@ -8481,18 +8479,33 @@ package body Sem_Ch12 is -- Do not copy the associated node, which points to the generic copy -- of the aggregate. + -- ????We ought to be able to get rid of all the Union_Id conversions - declare - use Atree.Unchecked_Access; - -- This code section is part of the implementation of an untyped - -- tree traversal, so it needs direct access to node fields. + if Nkind (N) = N_Aggregate then + Set_Aggregate_Bounds + (New_N, + Node_Id (Copy_Generic_Descendant + (Union_Id (Aggregate_Bounds (N))))); - begin - Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N))); - Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N))); - Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N))); - Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N))); - end; + elsif Nkind (N) = N_Extension_Aggregate then + Set_Ancestor_Part + (New_N, + Node_Id (Copy_Generic_Descendant + (Union_Id (Ancestor_Part (N))))); + + else + pragma Assert (False); + end if; + + Set_Expressions + (New_N, + List_Id (Copy_Generic_Descendant (Union_Id (Expressions (N))))); + Set_Component_Associations + (New_N, + List_Id (Copy_Generic_Descendant + (Union_Id (Component_Associations (N))))); + Set_Etype + (New_N, Node_Id (Copy_Generic_Descendant (Union_Id (Etype (N))))); -- Allocators do not have an identifier denoting the access type, so we -- must locate it through the expression to check whether the views are @@ -11403,14 +11416,15 @@ package body Sem_Ch12 is Actual, Gen_Obj); Error_Msg_N ("\with atomic object actual (RM C.6(12))", Actual); - elsif Is_Volatile_Object (Actual) and then not Is_Volatile (Orig_Ftyp) + elsif Is_Volatile_Object_Ref (Actual) + and then not Is_Volatile (Orig_Ftyp) then Error_Msg_NE ("cannot instantiate nonvolatile formal & of mode in out", Actual, Gen_Obj); Error_Msg_N ("\with volatile object actual (RM C.6(12))", Actual); - elsif Is_Volatile_Full_Access_Object (Actual) + elsif Is_Volatile_Full_Access_Object_Ref (Actual) and then not Is_Volatile_Full_Access (Orig_Ftyp) then Error_Msg_NE @@ -15608,6 +15622,11 @@ package body Sem_Ch12 is elsif E = Standard_Standard then return True; + -- E should be an entity, but it is not always + + elsif Nkind (E) not in N_Entity then -- ???? + return False; + elsif Is_Child_Unit (E) and then (Is_Instance_Node (Parent (N2)) or else (Nkind (Parent (N2)) = N_Expanded_Name @@ -16275,10 +16294,6 @@ package body Sem_Ch12 is Qual : Node_Id := Empty; Typ : Entity_Id := Empty; - use Atree.Unchecked_Access; - -- This code section is part of implementing an untyped tree - -- traversal, so it needs direct access to node fields. - begin N2 := Get_Associated_Node (N); @@ -16341,10 +16356,19 @@ package body Sem_Ch12 is end if; end if; - Save_Global_Descendant (Field1 (N)); - Save_Global_Descendant (Field2 (N)); - Save_Global_Descendant (Field3 (N)); - Save_Global_Descendant (Field5 (N)); + if Nkind (N) = N_Aggregate then + Save_Global_Descendant (Union_Id (Aggregate_Bounds (N))); + + elsif Nkind (N) = N_Extension_Aggregate then + Save_Global_Descendant (Union_Id (Ancestor_Part (N))); + + else + pragma Assert (False); + end if; + + Save_Global_Descendant (Union_Id (Expressions (N))); + Save_Global_Descendant (Union_Id (Component_Associations (N))); + Save_Global_Descendant (Union_Id (Etype (N))); if Present (Qual) then Rewrite (N, Qual); @@ -16372,16 +16396,9 @@ package body Sem_Ch12 is ------------------------------------ procedure Save_References_In_Descendants (N : Node_Id) is - use Atree.Unchecked_Access; - -- This code section is part of implementing an untyped tree - -- traversal, so it needs direct access to node fields. - + procedure Walk is new Walk_Sinfo_Fields (Save_Global_Descendant); begin - Save_Global_Descendant (Field1 (N)); - Save_Global_Descendant (Field2 (N)); - Save_Global_Descendant (Field3 (N)); - Save_Global_Descendant (Field4 (N)); - Save_Global_Descendant (Field5 (N)); + Walk (N); end Save_References_In_Descendants; ----------------------------------- @@ -16586,10 +16603,6 @@ package body Sem_Ch12 is Context : Node_Id; Do_Save : Boolean := True; - use Atree.Unchecked_Access; - -- This code section is part of implementing an untyped tree - -- traversal, so it needs direct access to node fields. - begin -- Do not save global references in pragmas generated from aspects -- because the pragmas will be regenerated at instantiation time. @@ -16621,14 +16634,12 @@ package body Sem_Ch12 is -- For all other cases, save all global references within the -- descendants, but skip the following semantic fields: - - -- Field1 - Next_Pragma - -- Field3 - Corresponding_Aspect - -- Field5 - Next_Rep_Item + -- Next_Pragma, Corresponding_Aspect, Next_Rep_Item. if Do_Save then - Save_Global_Descendant (Field2 (Prag)); - Save_Global_Descendant (Field4 (Prag)); + Save_Global_Descendant + (Union_Id (Pragma_Argument_Associations (N))); + Save_Global_Descendant (Union_Id (Pragma_Identifier (N))); end if; end Save_References_In_Pragma; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e77a835166f..4002d82d42a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Disp; use Exp_Disp; @@ -60,7 +62,9 @@ with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index f590f6be6e5..ff5466dcd2f 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -24,14 +24,16 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Utils; use Einfo.Utils; with Namet; use Namet; with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; with Sem_Ch8; use Sem_Ch8; with Sem_Dim; use Sem_Dim; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Stand; use Stand; with Uintp; use Uintp; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e6309e68684..6b9715324ab 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -29,7 +29,9 @@ with Checks; use Checks; with Contracts; use Contracts; with Debug; use Debug; with Elists; use Elists; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Eval_Fat; use Eval_Fat; with Exp_Ch3; use Exp_Ch3; @@ -72,7 +74,9 @@ with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Targparm; use Targparm; @@ -1337,7 +1341,20 @@ package body Sem_Ch3 is and then Present (Entity (S)) and then Ekind (Root_Type (Entity (S))) = E_Incomplete_Type then - Set_Directly_Designated_Type (T, Entity (S)); + -- The following "if" prevents us from blowing up if the access + -- type is illegally completing something else. + + if T in E_Void_Id + | Access_Kind_Id + | E_Private_Type_Id + | E_Limited_Private_Type_Id + | Incomplete_Kind_Id + then + Set_Directly_Designated_Type (T, Entity (S)); + + else + pragma Assert (Error_Posted (T)); + end if; -- If the designated type is a limited view, we cannot tell if -- the full view contains tasks, and there is no way to handle @@ -1396,45 +1413,47 @@ package body Sem_Ch3 is Set_Ekind (T, E_Access_Type); end if; - Full_Desig := Designated_Type (T); + if not Error_Posted (T) then + Full_Desig := Designated_Type (T); - if Base_Type (Full_Desig) = T then - Error_Msg_N ("access type cannot designate itself", S); + if Base_Type (Full_Desig) = T then + Error_Msg_N ("access type cannot designate itself", S); - -- In Ada 2005, the type may have a limited view through some unit in - -- its own context, allowing the following circularity that cannot be - -- detected earlier. + -- In Ada 2005, the type may have a limited view through some unit in + -- its own context, allowing the following circularity that cannot be + -- detected earlier. - elsif Is_Class_Wide_Type (Full_Desig) and then Etype (Full_Desig) = T - then - Error_Msg_N - ("access type cannot designate its own class-wide type", S); + elsif Is_Class_Wide_Type (Full_Desig) and then Etype (Full_Desig) = T + then + Error_Msg_N + ("access type cannot designate its own class-wide type", S); - -- Clean up indication of tagged status to prevent cascaded errors + -- Clean up indication of tagged status to prevent cascaded errors - Set_Is_Tagged_Type (T, False); - end if; + Set_Is_Tagged_Type (T, False); + end if; - Set_Etype (T, T); + Set_Etype (T, T); - -- For SPARK, check that the designated type is compatible with - -- respect to volatility with the access type. + -- For SPARK, check that the designated type is compatible with + -- respect to volatility with the access type. - if SPARK_Mode /= Off - and then Comes_From_Source (T) - then - -- ??? UNIMPLEMENTED - -- In the case where the designated type is incomplete at this point, - -- performing this check here is harmless but the check will need to - -- be repeated when the designated type is complete. + if SPARK_Mode /= Off + and then Comes_From_Source (T) + then + -- ??? UNIMPLEMENTED + -- In the case where the designated type is incomplete at this + -- point, performing this check here is harmless but the check + -- will need to be repeated when the designated type is complete. - -- The preceding call to Comes_From_Source is needed because the - -- FE sometimes introduces implicitly declared access types. See, - -- for example, the expansion of nested_po.ads in OA28-015. + -- The preceding call to Comes_From_Source is needed because the + -- FE sometimes introduces implicitly declared access types. See, + -- for example, the expansion of nested_po.ads in OA28-015. - Check_Volatility_Compatibility - (Full_Desig, T, "designated type", "access type", - Srcpos_Bearer => T); + Check_Volatility_Compatibility + (Full_Desig, T, "designated type", "access type", + Srcpos_Bearer => T); + end if; end if; -- If the type has appeared already in a with_type clause, it is frozen @@ -4746,6 +4765,10 @@ package body Sem_Ch3 is -- Now establish the proper kind and type of the object + if Ekind (Id) = E_Void then + Reinit_Field_To_Zero (Id, Next_Inlined_Subprogram); + end if; + if Constant_Present (N) then Set_Ekind (Id, E_Constant); Set_Is_True_Constant (Id); @@ -6204,6 +6227,12 @@ package body Sem_Ch3 is else pragma Assert (Nkind (Def) = N_Unconstrained_Array_Definition); + if Ekind (T) in Incomplete_Or_Private_Kind then + Reinit_Field_To_Zero (T, Stored_Constraint); + else + pragma Assert (Ekind (T) = E_Void); + end if; + Set_Ekind (T, E_Array_Type); Init_Size_Align (T); Set_Etype (T, T); @@ -12494,6 +12523,10 @@ package body Sem_Ch3 is Set_Homonym (Full, Save_Homonym); Set_Associated_Node_For_Itype (Full, Related_Nod); + if Ekind (Full) in Incomplete_Or_Private_Kind then + Reinit_Field_To_Zero (Full, Private_Dependents); + end if; + -- Set common attributes for all subtypes: kind, convention, etc. Set_Ekind (Full, Subtype_Kind (Ekind (Full_Base))); @@ -17892,9 +17925,8 @@ package body Sem_Ch3 is T := Access_Definition (Related_Nod, Obj_Def); Set_Is_Local_Anonymous_Access - (T, - V => (Ada_Version < Ada_2012) - or else (Nkind (P) /= N_Object_Declaration) + (T, Ada_Version < Ada_2012 + or else Nkind (P) /= N_Object_Declaration or else Is_Library_Level_Entity (Defining_Identifier (P))); -- Otherwise, the object definition is just a subtype_mark @@ -19184,6 +19216,20 @@ package body Sem_Ch3 is -- abstract, its Etype points back to the specific root type, and it -- cannot have any invariants. + if Ekind (CW_Type) in Incomplete_Or_Private_Kind then + Reinit_Field_To_Zero (CW_Type, Private_Dependents); + + elsif Ekind (CW_Type) in Concurrent_Kind then + if Ekind (CW_Type) = E_Task_Type then + Reinit_Field_To_Zero (CW_Type, Is_Elaboration_Checks_OK_Id); + Reinit_Field_To_Zero (CW_Type, Is_Elaboration_Warnings_OK_Id); + end if; + + Reinit_Field_To_Zero (CW_Type, First_Private_Entity); + Reinit_Field_To_Zero (CW_Type, Scope_Depth_Value); + Reinit_Field_To_Zero (CW_Type, SPARK_Aux_Pragma_Inherited); + end if; + Set_Ekind (CW_Type, E_Class_Wide_Type); Set_Is_Tagged_Type (CW_Type, True); Set_Direct_Primitive_Operations (CW_Type, New_Elmt_List); @@ -20364,6 +20410,11 @@ package body Sem_Ch3 is Discr_Number := Uint_1; while Present (Discr) loop Id := Defining_Identifier (Discr); + + if Ekind (Id) = E_In_Parameter then -- ????Above says E_Void + Reinit_Field_To_Zero (Id, Discriminal_Link); + end if; + Set_Ekind (Id, E_Discriminant); Init_Component_Location (Id); Init_Esize (Id); @@ -20724,7 +20775,7 @@ package body Sem_Ch3 is & "has no discriminants", Full_T); end if; - -- ??????? Do we implement the following properly ????? + -- Do we implement the following properly??? -- If the ancestor subtype of a private extension has constrained -- discriminants, then the parent subtype of the full view shall -- impose a statically matching constraint on those discriminants @@ -20803,7 +20854,7 @@ package body Sem_Ch3 is and then not Has_Discriminants (Priv_T) and then Has_Defaulted_Discriminants (Full_T) then - Set_Has_Constrained_Partial_View (Full_T); + Set_Has_Constrained_Partial_View (Base_Type (Full_T)); Set_Has_Constrained_Partial_View (Priv_T); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index f89db028420..5e10e36f2c2 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -26,7 +26,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Util; use Exp_Util; @@ -57,7 +59,9 @@ with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -5291,7 +5295,7 @@ package body Sem_Ch4 is Set_Parent (Par, Parent (Parent (N))); if Try_Object_Operation - (Sinfo.Name (Par), CW_Test_Only => True) + (Sinfo.Nodes.Name (Par), CW_Test_Only => True) then return; end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 0aef9321d60..9b346941d30 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Expander; use Expander; with Exp_Ch6; use Exp_Ch6; @@ -56,7 +58,9 @@ with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Snames; use Snames; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Targparm; use Targparm; with Tbuild; use Tbuild; with Ttypes; use Ttypes; @@ -1315,6 +1319,10 @@ package body Sem_Ch5 is Set_Identifier (N, Empty); else + if Ekind (Ent) = E_Label then + Reinit_Field_To_Zero (Ent, Enclosing_Scope); + end if; + Set_Ekind (Ent, E_Block); Generate_Reference (Ent, N, ' '); Generate_Definition (Ent); @@ -3752,6 +3760,7 @@ package body Sem_Ch5 is -- parser for generic units. if Ekind (Ent) = E_Label then + Reinit_Field_To_Zero (Ent, Enclosing_Scope); Set_Ekind (Ent, E_Loop); if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a919a0af22d..284c41298c6 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -28,7 +28,9 @@ with Atree; use Atree; with Checks; use Checks; with Contracts; use Contracts; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Expander; use Expander; @@ -77,7 +79,9 @@ with Sem_Type; use Sem_Type; with Sem_Warn; use Sem_Warn; with Sinput; use Sinput; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinfo.CN; use Sinfo.CN; with Snames; use Snames; with Stringt; use Stringt; @@ -1844,6 +1848,11 @@ package body Sem_Ch6 is -- Visible generic entity is callable within its own body Set_Ekind (Gen_Id, Ekind (Body_Id)); + Reinit_Field_To_Zero (Body_Id, Has_Out_Or_In_Out_Parameter, + Old_Ekind => + (E_Function | E_Procedure | + E_Generic_Function | E_Generic_Procedure => True, + others => False)); Set_Ekind (Body_Id, E_Subprogram_Body); Set_Convention (Body_Id, Convention (Gen_Id)); Set_Is_Obsolescent (Body_Id, Is_Obsolescent (Gen_Id)); @@ -1920,6 +1929,8 @@ package body Sem_Ch6 is -- Outside of its body, unit is generic again + Reinit_Field_To_Zero (Gen_Id, Has_Nested_Subprogram, + Old_Ekind => (E_Function | E_Procedure => True, others => False)); Set_Ekind (Gen_Id, Kind); Generate_Reference (Gen_Id, Body_Id, 'b', Set_Ref => False); @@ -4599,6 +4610,18 @@ package body Sem_Ch6 is Reference_Body_Formals (Spec_Id, Body_Id); end if; + Reinit_Field_To_Zero (Body_Id, Has_Out_Or_In_Out_Parameter); + Reinit_Field_To_Zero (Body_Id, Needs_No_Actuals, + Old_Ekind => (E_Function | E_Procedure => True, others => False)); + Reinit_Field_To_Zero (Body_Id, Is_Predicate_Function, + Old_Ekind => (E_Function | E_Procedure => True, others => False)); + Reinit_Field_To_Zero (Body_Id, Protected_Subprogram, + Old_Ekind => (E_Function | E_Procedure => True, others => False)); + + if Ekind (Body_Id) = E_Procedure then + Reinit_Field_To_Zero (Body_Id, Receiving_Entry); + end if; + Set_Ekind (Body_Id, E_Subprogram_Body); if Nkind (N) = N_Subprogram_Body_Stub then @@ -5766,8 +5789,21 @@ package body Sem_Ch6 is if Nkind (N) = N_Function_Specification then Set_Ekind (Designator, E_Function); Set_Mechanism (Designator, Default_Mechanism); + else - Set_Ekind (Designator, E_Procedure); + case Ekind (Designator) is + when E_Subprogram_Body | E_Void => + Reinit_Field_To_Zero + (Designator, Corresponding_Protected_Entry); + Set_Ekind (Designator, E_Procedure); + + when E_Procedure | E_Generic_Procedure => + null; + + when others => + pragma Assert (False); + end case; + Set_Etype (Designator, Standard_Void_Type); end if; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index dcb2af5a6ae..2f65ff20a82 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -32,7 +32,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Contracts; use Contracts; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Disp; use Exp_Disp; @@ -64,7 +66,9 @@ with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Snames; use Snames; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Style; with Uintp; use Uintp; @@ -2924,6 +2928,11 @@ package body Sem_Ch7 is Set_Is_Potentially_Use_Visible (Id); end if; + -- Avoid crash caused by previous errors + + elsif No (Etype (Id)) and then Serious_Errors_Detected /= 0 then + null; + -- We need to avoid incorrectly marking enumeration literals as -- non-visible when a visible use-all-type clause is in effect. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c60ebbd09d9..b88a36ac80c 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Disp; use Exp_Disp; @@ -65,7 +67,9 @@ with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sem_Type; use Sem_Type; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinfo.CN; use Sinfo.CN; with Snames; use Snames; with Style; @@ -1457,10 +1461,6 @@ package body Sem_Ch8 is Set_Ekind (Id, E_Variable); end if; - -- Initialize the object size and alignment. Note that we used to call - -- Init_Size_Align here, but that's wrong for objects which have only - -- an Esize, not an RM_Size field. - Init_Object_Size_Align (Id); -- If N comes from source then check that the original node is an @@ -1545,10 +1545,11 @@ package body Sem_Ch8 is -- renamed object is atomic, independent, volatile or VFA. These flags -- are set on the renamed object in the RM legality sense. - Set_Is_Atomic (Id, Is_Atomic_Object (Nam)); - Set_Is_Independent (Id, Is_Independent_Object (Nam)); - Set_Is_Volatile (Id, Is_Volatile_Object (Nam)); - Set_Is_Volatile_Full_Access (Id, Is_Volatile_Full_Access_Object (Nam)); + Set_Is_Atomic (Id, Is_Atomic_Object (Nam)); + Set_Is_Independent (Id, Is_Independent_Object (Nam)); + Set_Is_Volatile (Id, Is_Volatile_Object_Ref (Nam)); + Set_Is_Volatile_Full_Access + (Id, Is_Volatile_Full_Access_Object_Ref (Nam)); -- Treat as volatile if we just set the Volatile flag @@ -3277,6 +3278,9 @@ package body Sem_Ch8 is -- constructed later at the freeze point, so indicate that the -- completion has not been seen yet. + Reinit_Field_To_Zero (New_S, Has_Out_Or_In_Out_Parameter); + Reinit_Field_To_Zero (New_S, Needs_No_Actuals, + Old_Ekind => (E_Function | E_Procedure => True, others => False)); Set_Ekind (New_S, E_Subprogram_Body); New_S := Rename_Spec; Set_Has_Completion (Rename_Spec, False); @@ -6829,7 +6833,17 @@ package body Sem_Ch8 is end if; end if; - Change_Selected_Component_To_Expanded_Name (N); + case Nkind (N) is + when N_Selected_Component => + Reinit_Field_To_Zero (N, Is_Prefixed_Call); + Change_Selected_Component_To_Expanded_Name (N); + + when N_Expanded_Name => + null; + + when others => + pragma Assert (False); + end case; -- Preserve relevant elaboration-related attributes of the context which -- are no longer available or very expensive to recompute once analysis, diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 204cd0075a5..c8962a91a62 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -28,7 +28,9 @@ with Atree; use Atree; with Checks; use Checks; with Contracts; use Contracts; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Exp_Ch9; use Exp_Ch9; with Elists; use Elists; @@ -59,7 +61,9 @@ with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Snames; use Snames; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Style; with Tbuild; use Tbuild; with Uintp; use Uintp; diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index f6854f958a8..82cfcfc1311 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -25,7 +25,9 @@ with Aspects; use Aspects; with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Exp_Util; use Exp_Util; with Lib; use Lib; @@ -39,7 +41,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 12754223ad9..e1b0bca519d 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; with Elists; use Elists; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Exp_Disp; use Exp_Disp; with Exp_Util; use Exp_Util; with Exp_Ch7; use Exp_Ch7; @@ -50,7 +52,9 @@ with Sem_Eval; use Sem_Eval; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Snames; use Snames; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Tbuild; use Tbuild; with Uintp; use Uintp; with Warnsw; use Warnsw; diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 6e65837c1f2..15767cff266 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Casing; use Casing; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Exp_Dist; use Exp_Dist; with Exp_Tss; use Exp_Tss; @@ -40,7 +42,9 @@ with Sem_Disp; use Sem_Disp; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Stand; use Stand; with Stringt; use Stringt; with Tbuild; use Tbuild; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index a50fafdc371..ac99e1d21e2 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -27,7 +27,9 @@ with ALI; use ALI; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Ch11; use Exp_Ch11; @@ -52,7 +54,9 @@ with Sem_Ch8; use Sem_Ch8; with Sem_Disp; use Sem_Disp; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index 2c97cc9d60a..e6d19f81c6b 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -24,7 +24,9 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Lib; use Lib; with Namet; use Namet; @@ -35,7 +37,8 @@ with Sem_Aux; use Sem_Aux; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sinput; use Sinput; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 2f1acc7ce12..fe5c397331f 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Eval_Fat; use Eval_Fat; @@ -51,7 +53,9 @@ with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sem_Type; use Sem_Type; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -4995,7 +4999,7 @@ package body Sem_Eval is Check_Elab_Call; if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Modulus (Typ); + Modulus := Einfo.Entities.Modulus (Typ); else Modulus := Uint_2 ** RM_Size (Typ); end if; @@ -5023,7 +5027,7 @@ package body Sem_Eval is Fold_Uint (N, Expr_Value (Left), Static => Static); else if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Modulus (Typ); + Modulus := Einfo.Entities.Modulus (Typ); else Modulus := Uint_2 ** RM_Size (Typ); end if; @@ -5047,7 +5051,7 @@ package body Sem_Eval is Two_Y : constant Uint := Uint_2 ** Expr_Value (Right); begin if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Modulus (Typ); + Modulus := Einfo.Entities.Modulus (Typ); else Modulus := Uint_2 ** RM_Size (Typ); end if; diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index b0155cc692f..dcd7ea5e59e 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -26,7 +26,9 @@ -- Processing for intrinsic subprogram declarations with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Lib; use Lib; with Namet; use Namet; @@ -34,7 +36,9 @@ with Opt; use Opt; with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index c948095cb9a..497f8133ba3 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -24,12 +24,15 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Namet; use Namet; with Sem; use Sem; with Sem_Aux; use Sem_Aux; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Snames; use Snames; package body Sem_Mech is diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 645b892ddd1..4eb27327419 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -36,7 +36,9 @@ with Checks; use Checks; with Contracts; use Contracts; with Csets; use Csets; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Exp_Dist; use Exp_Dist; @@ -76,7 +78,9 @@ with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinfo.CN; use Sinfo.CN; with Sinput; use Sinput; with Stringt; use Stringt; @@ -16098,7 +16102,8 @@ package body Sem_Prag is begin Set_Is_Exported (Id2, Is_Exported (Def_Id)); Set_First_Rep_Item (Id2, First_Rep_Item (Def_Id)); - Set_Interface_Name (Id2, Einfo.Interface_Name (Def_Id)); + Set_Interface_Name + (Id2, Einfo.Entities.Interface_Name (Def_Id)); end; end if; end Export; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 898f317f8f4..f3caca74131 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -28,7 +28,9 @@ with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; with Debug_A; use Debug_A; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Expander; use Expander; with Exp_Ch6; use Exp_Ch6; @@ -72,7 +74,9 @@ with Sem_Mech; use Sem_Mech; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinfo.CN; use Sinfo.CN; with Snames; use Snames; with Stand; use Stand; @@ -1285,8 +1289,10 @@ package body Sem_Res is Check_Parameterless_Call (Explicit_Actual_Parameter (N)); elsif Nkind (N) = N_Operator_Symbol then - Change_Operator_Symbol_To_String_Literal (N); + Set_Etype (N, Empty); + Set_Entity (N, Empty); Set_Is_Overloaded (N, False); + Change_Operator_Symbol_To_String_Literal (N); Set_Etype (N, Any_String); end if; end Check_Parameterless_Call; @@ -4804,7 +4810,7 @@ package body Sem_Res is Error_Msg_N ("\which is passed by reference (RM C.6(12))", A); - elsif Is_Volatile_Object (A) + elsif Is_Volatile_Object_Ref (A) and then not Is_Volatile (Etype (F)) then Error_Msg_NE @@ -4813,7 +4819,7 @@ package body Sem_Res is Error_Msg_N ("\which is passed by reference (RM C.6(12))", A); - elsif Is_Volatile_Full_Access_Object (A) + elsif Is_Volatile_Full_Access_Object_Ref (A) and then not Is_Volatile_Full_Access (Etype (F)) then Error_Msg_NE diff --git a/gcc/ada/sem_scil.adb b/gcc/ada/sem_scil.adb index 9c379de7310..bba92473b5f 100644 --- a/gcc/ada/sem_scil.adb +++ b/gcc/ada/sem_scil.adb @@ -23,11 +23,14 @@ -- -- ------------------------------------------------------------------------------ -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Nlists; use Nlists; with Rtsfind; use Rtsfind; with Sem_Aux; use Sem_Aux; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Stand; use Stand; with SCIL_LL; use SCIL_LL; diff --git a/gcc/ada/sem_smem.adb b/gcc/ada/sem_smem.adb index 9dbc85148ff..95dc94280da 100644 --- a/gcc/ada/sem_smem.adb +++ b/gcc/ada/sem_smem.adb @@ -24,11 +24,14 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Namet; use Namet; with Sem_Aux; use Sem_Aux; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Snames; use Snames; package body Sem_Smem is diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 8ffdda3f800..bf70491783b 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -27,7 +27,9 @@ with Aspects; use Aspects; with Atree; use Atree; with Alloc; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Nlists; use Nlists; with Errout; use Errout; @@ -44,7 +46,9 @@ with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; with Sem_Util; use Sem_Util; with Stand; use Stand; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Table; with Treepr; use Treepr; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4e6fef599e6..5c1368edadb 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -26,6 +26,7 @@ with Casing; use Casing; with Checks; use Checks; with Debug; use Debug; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; with Erroutc; use Erroutc; @@ -58,7 +59,9 @@ with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_Warn; use Sem_Warn; with Sem_Type; use Sem_Type; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Stand; use Stand; with Style; @@ -6471,7 +6474,6 @@ package body Sem_Util is Remove (Op_List, Node (Second)); else - pragma Assert (False); raise Program_Error; end if; end if; @@ -13872,7 +13874,7 @@ package body Sem_Util is elsif Is_Record_Type (Typ) then Comp := First_Component (Typ); while Present (Comp) loop - if Is_Volatile_Object (Comp) then + if Is_Volatile_Object_Ref (Comp) then return True; end if; @@ -17225,7 +17227,8 @@ package body Sem_Util is function Is_Full_Access_Object (N : Node_Id) return Boolean is begin - return Is_Atomic_Object (N) or else Is_Volatile_Full_Access_Object (N); + return Is_Atomic_Object (N) + or else Is_Volatile_Full_Access_Object_Ref (N); end Is_Full_Access_Object; ------------------------------- @@ -20955,11 +20958,11 @@ package body Sem_Util is and then Scope (Scope (Scope (Root))) = Standard_Standard; end Is_Visibly_Controlled; - -------------------------------------- - -- Is_Volatile_Full_Access_Object -- - -------------------------------------- + ---------------------------------------- + -- Is_Volatile_Full_Access_Object_Ref -- + ---------------------------------------- - function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean is + function Is_Volatile_Full_Access_Object_Ref (N : Node_Id) return Boolean is function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean; -- Determine whether arbitrary entity Id denotes an object that is -- Volatile_Full_Access. @@ -20977,7 +20980,7 @@ package body Sem_Util is Is_Volatile_Full_Access (Etype (Id))); end Is_VFA_Object_Entity; - -- Start of processing for Is_Volatile_Full_Access_Object + -- Start of processing for Is_Volatile_Full_Access_Object_Ref begin if Is_Entity_Name (N) then @@ -20992,7 +20995,7 @@ package body Sem_Util is else return False; end if; - end Is_Volatile_Full_Access_Object; + end Is_Volatile_Full_Access_Object_Ref; -------------------------- -- Is_Volatile_Function -- @@ -21024,11 +21027,11 @@ package body Sem_Util is end if; end Is_Volatile_Function; - ------------------------ - -- Is_Volatile_Object -- - ------------------------ + ---------------------------- + -- Is_Volatile_Object_Ref -- + ---------------------------- - function Is_Volatile_Object (N : Node_Id) return Boolean is + function Is_Volatile_Object_Ref (N : Node_Id) return Boolean is function Is_Volatile_Object_Entity (Id : Entity_Id) return Boolean; -- Determine whether arbitrary entity Id denotes an object that is -- Volatile. @@ -21074,7 +21077,7 @@ package body Sem_Util is then return True; - elsif Is_Volatile_Object (P) then + elsif Is_Volatile_Object_Ref (P) then return True; else @@ -21082,7 +21085,7 @@ package body Sem_Util is end if; end Prefix_Has_Volatile_Components; - -- Start of processing for Is_Volatile_Object + -- Start of processing for Is_Volatile_Object_Ref begin if Is_Entity_Name (N) then @@ -21101,7 +21104,7 @@ package body Sem_Util is else return False; end if; - end Is_Volatile_Object; + end Is_Volatile_Object_Ref; ----------------------------- -- Iterate_Call_Parameters -- @@ -22900,9 +22903,6 @@ package body Sem_Util is -- This routine performs low-level tree manipulations and needs access -- to the internals of the tree. - use Atree.Unchecked_Access; - use Atree_Private_Part; - EWA_Level : Nat := 0; -- This counter keeps track of how many N_Expression_With_Actions nodes -- are encountered during a depth-first traversal of the subtree. These @@ -23054,6 +23054,7 @@ package body Sem_Util is -- valid syntactic fields. Par_Nod is the expected parent of the -- syntactic field. Flag Semantic should be set when the input is a -- semantic field. + -- ????So it's visiting sem fields twice? procedure Visit_Itype (Itype : Entity_Id); -- Visit itype Itype. This action may create a new entity for Itype and @@ -23444,6 +23445,25 @@ package body Sem_Util is function Copy_Node_With_Replacement (N : Node_Id) return Node_Id is Result : Node_Id; + function Transform (U : Union_Id) return Union_Id; + -- Copies one field, replacing N with Result + + --------------- + -- Transform -- + --------------- + + function Transform (U : Union_Id) return Union_Id is + begin + return Copy_Field_With_Replacement + (Field => U, + Old_Par => N, + New_Par => Result); + end Transform; + + procedure Walk is new Walk_Sinfo_Fields_Pairwise (Transform); + + -- Start of processing for Copy_Node_With_Replacement + begin -- Assume that the node must be returned unchanged @@ -23454,35 +23474,7 @@ package body Sem_Util is Result := New_Copy (N); - Set_Field1 (Result, - Copy_Field_With_Replacement - (Field => Field1 (Result), - Old_Par => N, - New_Par => Result)); - - Set_Field2 (Result, - Copy_Field_With_Replacement - (Field => Field2 (Result), - Old_Par => N, - New_Par => Result)); - - Set_Field3 (Result, - Copy_Field_With_Replacement - (Field => Field3 (Result), - Old_Par => N, - New_Par => Result)); - - Set_Field4 (Result, - Copy_Field_With_Replacement - (Field => Field4 (Result), - Old_Par => N, - New_Par => Result)); - - Set_Field5 (Result, - Copy_Field_With_Replacement - (Field => Field5 (Result), - Old_Par => N, - New_Par => Result)); + Walk (Result, Result); -- Update the Comes_From_Source and Sloc attributes of the node -- in case the caller has supplied new values. @@ -23622,7 +23614,7 @@ package body Sem_Util is -- A new source location defaults the Comes_From_Source attribute if New_Sloc /= No_Location then - Set_Comes_From_Source (N, Default_Node.Comes_From_Source); + Set_Comes_From_Source (N, Get_Comes_From_Source_Default); Set_Sloc (N, New_Sloc); end if; end Update_CFS_Sloc; @@ -24229,25 +24221,17 @@ package body Sem_Util is EWA_Inner_Scope_Level := EWA_Inner_Scope_Level + 1; end if; - Visit_Field - (Field => Field1 (N), - Par_Nod => N); - - Visit_Field - (Field => Field2 (N), - Par_Nod => N); - - Visit_Field - (Field => Field3 (N), - Par_Nod => N); - - Visit_Field - (Field => Field4 (N), - Par_Nod => N); + declare + procedure Action (U : Union_Id); + procedure Action (U : Union_Id) is + begin + Visit_Field (Field => U, Par_Nod => N); + end Action; - Visit_Field - (Field => Field5 (N), - Par_Nod => N); + procedure Walk is new Walk_Sinfo_Fields (Action); + begin + Walk (N); + end; if EWA_Level > 0 and then Nkind (N) in N_Block_Statement @@ -26181,14 +26165,16 @@ package body Sem_Util is Partial_DIC_Proc := Partial_DIC_Procedure (From_Typ); -- The setting of the attributes is intentionally conservative. This - -- prevents accidental clobbering of enabled attributes. + -- prevents accidental clobbering of enabled attributes. We need to + -- call Base_Type twice, because it is sometimes not set to an actual + -- base type. if Has_Inherited_DIC (From_Typ) then - Set_Has_Inherited_DIC (Typ); + Set_Has_Inherited_DIC (Base_Type (Base_Type (Typ))); end if; if Has_Own_DIC (From_Typ) then - Set_Has_Own_DIC (Typ); + Set_Has_Own_DIC (Base_Type (Base_Type (Typ))); end if; if Present (DIC_Proc) and then No (DIC_Procedure (Typ)) then @@ -27336,66 +27322,6 @@ package body Sem_Util is return False; end Scope_Within_Or_Same; - -------------------- - -- Set_Convention -- - -------------------- - - procedure Set_Convention (E : Entity_Id; Val : Snames.Convention_Id) is - begin - Basic_Set_Convention (E, Val); - - if Is_Type (E) - and then Is_Access_Subprogram_Type (Base_Type (E)) - and then Has_Foreign_Convention (E) - then - Set_Can_Use_Internal_Rep (E, False); - end if; - - -- If E is an object, including a component, and the type of E is an - -- anonymous access type with no convention set, then also set the - -- convention of the anonymous access type. We do not do this for - -- anonymous protected types, since protected types always have the - -- default convention. - - if Present (Etype (E)) - and then (Is_Object (E) - - -- Allow E_Void (happens for pragma Convention appearing - -- in the middle of a record applying to a component) - - or else Ekind (E) = E_Void) - then - declare - Typ : constant Entity_Id := Etype (E); - - begin - if Ekind (Typ) in E_Anonymous_Access_Type - | E_Anonymous_Access_Subprogram_Type - and then not Has_Convention_Pragma (Typ) - then - Basic_Set_Convention (Typ, Val); - Set_Has_Convention_Pragma (Typ); - - -- And for the access subprogram type, deal similarly with the - -- designated E_Subprogram_Type, which is always internal. - - if Ekind (Typ) = E_Anonymous_Access_Subprogram_Type then - declare - Dtype : constant Entity_Id := Designated_Type (Typ); - begin - if Ekind (Dtype) = E_Subprogram_Type - and then not Has_Convention_Pragma (Dtype) - then - Basic_Set_Convention (Dtype, Val); - Set_Has_Convention_Pragma (Dtype); - end if; - end; - end if; - end if; - end; - end if; - end Set_Convention; - ------------------------ -- Set_Current_Entity -- ------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b3a53a23e8e..b4b5d10bc3f 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -27,7 +27,8 @@ with Aspects; use Aspects; with Atree; use Atree; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; with Exp_Tss; use Exp_Tss; with Namet; use Namet; with Opt; use Opt; @@ -2388,7 +2389,7 @@ package Sem_Util is -- Initialize/Adjust/Finalize subprogram does not override the inherited -- one. - function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean; + function Is_Volatile_Full_Access_Object_Ref (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to an object -- which is Volatile_Full_Access. @@ -2397,7 +2398,7 @@ package Sem_Util is -- pragma Volatile_Function. Protected functions are treated as volatile -- (SPARK RM 7.1.2). - function Is_Volatile_Object (N : Node_Id) return Boolean; + function Is_Volatile_Object_Ref (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to a volatile -- object as per RM C.6(8). Note that the test here is for something that -- is actually declared as volatile, not for an object that gets treated @@ -3018,13 +3019,6 @@ package Sem_Util is -- the same scope. Note that scopes are partially ordered, so Scope_Within -- (A, B) and Scope_Within (B, A) may both return False. - procedure Set_Convention (E : Entity_Id; Val : Convention_Id); - -- Same as Basic_Set_Convention, but with an extra check for access types. - -- In particular, if E is an access-to-subprogram type, and Val is a - -- foreign convention, then we set Can_Use_Internal_Rep to False on E. - -- Also, if the Etype of E is set and is an anonymous access type with - -- no convention set, this anonymous type inherits the convention of E. - procedure Set_Current_Entity (E : Entity_Id); pragma Inline (Set_Current_Entity); -- Establish the entity E as the currently visible definition of its diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index d602cd12d6b..43ce5effb4f 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -25,7 +25,9 @@ with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Exp_Code; use Exp_Code; with Lib; use Lib; @@ -41,7 +43,9 @@ with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; @@ -2308,7 +2312,7 @@ package body Sem_Warn is procedure Check_Inner_Package (Pack : Entity_Id) is E : Entity_Id; - Un : constant Node_Id := Sinfo.Unit (Cnode); + Un : constant Node_Id := Sinfo.Nodes.Unit (Cnode); function Check_Use_Clause (N : Node_Id) return Traverse_Result; -- If N is a use_clause for Pack, emit warning diff --git a/gcc/ada/set_targ.ads b/gcc/ada/set_targ.ads index 46598706a9a..cfd9b702f24 100644 --- a/gcc/ada/set_targ.ads +++ b/gcc/ada/set_targ.ads @@ -36,7 +36,6 @@ -- of Wide_Character_Type uses twice the size of a C char, instead of the -- size of wchar_t, since this corresponds to expected Ada usage. -with Einfo; use Einfo; with Stand; use Stand; with Types; use Types; diff --git a/gcc/ada/sinfo-cn.adb b/gcc/ada/sinfo-cn.adb index d6079ba7162..9fc4e00fcff 100644 --- a/gcc/ada/sinfo-cn.adb +++ b/gcc/ada/sinfo-cn.adb @@ -32,25 +32,52 @@ with Atree; use Atree; with Snames; use Snames; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; package body Sinfo.CN is - use Atree.Unchecked_Access; - -- This package is one of the few packages which is allowed to make direct - -- references to tree nodes (since it is in the business of providing a - -- higher level of tree access which other clients are expected to use and - -- which implements checks). + procedure Assert_Expression_Fields_Zero (N : Node_Id); + -- Asserts that all fields documented in Sinfo as "plus fields for + -- expression" have their initial zero value. Note that N_Operator_Symbol + -- is not documented as having "plus fields for expression", but it is in + -- N_Subexpr, so it does. + -- ????This is redundant with Check_Vanishing_Fields in Atree. + + ----------------------------------- + -- Assert_Expression_Fields_Zero -- + ----------------------------------- + + procedure Assert_Expression_Fields_Zero (N : Node_Id) is + begin + pragma Assert (Paren_Count (N) = 0); + pragma Assert (No (Etype (N))); + pragma Assert (not Is_Overloaded (N)); + pragma Assert (not Is_Static_Expression (N)); + pragma Assert (not Raises_Constraint_Error (N)); + pragma Assert (not Must_Not_Freeze (N)); + pragma Assert (not Do_Range_Check (N)); + pragma Assert (not Has_Dynamic_Length_Check (N)); + pragma Assert (not Assignment_OK (N)); + pragma Assert (not Is_Controlling_Actual (N)); + end Assert_Expression_Fields_Zero; ------------------------------------------------------------ -- Change_Character_Literal_To_Defining_Character_Literal -- ------------------------------------------------------------ procedure Change_Character_Literal_To_Defining_Character_Literal - (N : in out Node_Id) + (N : Node_Id) is begin - Set_Nkind (N, N_Defining_Character_Literal); - N := Extend_Node (N); + Reinit_Field_To_Zero (N, Char_Literal_Value); +-- ????pragma Assert (No (Node2 (N))); -- Char_Literal_Value is Uint2 out of r + pragma Assert (No (Entity (N))); + pragma Assert (No (Associated_Node (N))); + pragma Assert (not Has_Private_View (N)); + Assert_Expression_Fields_Zero (N); + + Extend_Node (N); end Change_Character_Literal_To_Defining_Character_Literal; ------------------------------------ @@ -62,17 +89,27 @@ package body Sinfo.CN is Set_Do_Overflow_Check (N, False); Set_Do_Tag_Check (N, False); Set_Do_Length_Check (N, False); - Set_Nkind (N, N_Unchecked_Type_Conversion); + Mutate_Nkind (N, N_Unchecked_Type_Conversion); end Change_Conversion_To_Unchecked; ---------------------------------------------- -- Change_Identifier_To_Defining_Identifier -- ---------------------------------------------- - procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id) is + procedure Change_Identifier_To_Defining_Identifier (N : Node_Id) is begin - Set_Nkind (N, N_Defining_Identifier); - N := Extend_Node (N); + pragma Assert (No (Entity (N))); + pragma Assert (No (Associated_Node (N))); + pragma Assert (No (Original_Discriminant (N))); + pragma Assert (not Is_Elaboration_Checks_OK_Node (N)); + pragma Assert (not Is_SPARK_Mode_On_Node (N)); + pragma Assert (not Is_Elaboration_Warnings_OK_Node (N)); + pragma Assert (not Has_Private_View (N)); + pragma Assert (not Redundant_Use (N)); + pragma Assert (not Atomic_Sync_Required (N)); + Assert_Expression_Fields_Zero (N); + + Extend_Node (N); end Change_Identifier_To_Defining_Identifier; --------------------------------------------- @@ -132,12 +169,18 @@ package body Sinfo.CN is -------------------------------------------------------- procedure Change_Operator_Symbol_To_Defining_Operator_Symbol - (N : in out Node_Id) + (N : Node_Id) is begin - Set_Nkind (N, N_Defining_Operator_Symbol); - Set_Node2 (N, Empty); -- Clear unused Str2 field - N := Extend_Node (N); + Reinit_Field_To_Zero (N, Strval); +-- ????pragma Assert (No (Node3 (N))); -- Strval is Str3, 0 is out of range + pragma Assert (No (Entity (N))); + pragma Assert (No (Associated_Node (N))); + pragma Assert (No (Etype (N))); + pragma Assert (not Has_Private_View (N)); + Assert_Expression_Fields_Zero (N); + + Extend_Node (N); end Change_Operator_Symbol_To_Defining_Operator_Symbol; ---------------------------------------------- @@ -146,8 +189,15 @@ package body Sinfo.CN is procedure Change_Operator_Symbol_To_String_Literal (N : Node_Id) is begin - Set_Nkind (N, N_String_Literal); - Set_Node1 (N, Empty); -- clear Name1 field + Reinit_Field_To_Zero (N, Chars); + Set_Entity (N, Empty); +-- ????pragma Assert (No (Node1 (N))); -- Chars is Name1 out of range + pragma Assert (No (Entity (N))); + pragma Assert (No (Associated_Node (N))); + pragma Assert (No (Etype (N))); + pragma Assert (not Has_Private_View (N)); + + Mutate_Nkind (N, N_String_Literal); end Change_Operator_Symbol_To_String_Literal; ------------------------------------------------ @@ -156,7 +206,7 @@ package body Sinfo.CN is procedure Change_Selected_Component_To_Expanded_Name (N : Node_Id) is begin - Set_Nkind (N, N_Expanded_Name); + Mutate_Nkind (N, N_Expanded_Name); Set_Chars (N, Chars (Selector_Name (N))); end Change_Selected_Component_To_Expanded_Name; diff --git a/gcc/ada/sinfo-cn.ads b/gcc/ada/sinfo-cn.ads index d628ffb00f0..bf3231b982f 100644 --- a/gcc/ada/sinfo-cn.ads +++ b/gcc/ada/sinfo-cn.ads @@ -32,20 +32,19 @@ package Sinfo.CN is - procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id); + procedure Change_Identifier_To_Defining_Identifier (N : Node_Id); -- N must refer to a node of type N_Identifier. This node is modified to -- be of type N_Defining_Identifier. The scanner always returns identifiers -- as N_Identifier. The parser then uses this routine to change the node -- to be a defining identifier where the context demands it. This routine - -- also allocates the necessary extension node. Note that this procedure - -- may (but is not required to) change the Id of the node in question. + -- also allocates the necessary extension node. procedure Change_Character_Literal_To_Defining_Character_Literal - (N : in out Node_Id); + (N : Node_Id); -- Similar processing for a character literal procedure Change_Operator_Symbol_To_Defining_Operator_Symbol - (N : in out Node_Id); + (N : Node_Id); -- Similar processing for an operator symbol procedure Change_Conversion_To_Unchecked (N : Node_Id); diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb new file mode 100644 index 00000000000..abcda46bdfa --- /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; diff --git a/gcc/ada/sinfo-utils.ads b/gcc/ada/sinfo-utils.ads new file mode 100644 index 00000000000..7d11e2a3b28 --- /dev/null +++ b/gcc/ada/sinfo-utils.ads @@ -0,0 +1,148 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S I N F O . U T I L S -- +-- -- +-- 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. 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 Sinfo.Nodes; use Sinfo.Nodes; + +package Sinfo.Utils is + + ------------------------- + -- Iterator Procedures -- + ------------------------- + + -- The call to Next_xxx (N) is equivalent to N := Next_xxx (N) + + procedure Next_Entity (N : in out Node_Id); + procedure Next_Named_Actual (N : in out Node_Id); + procedure Next_Rep_Item (N : in out Node_Id); + procedure Next_Use_Clause (N : in out Node_Id); + + ------------------------------------------- + -- Miscellaneous Tree Access Subprograms -- + ------------------------------------------- + + function End_Location (N : Node_Id) return Source_Ptr; + -- N is an N_If_Statement or N_Case_Statement node, and this function + -- returns the location of the IF token in the END IF sequence by + -- translating the value of the End_Span field. + + -- WARNING: There is a matching C declaration of this subprogram in fe.h + + procedure Set_End_Location (N : Node_Id; S : Source_Ptr); + -- N is an N_If_Statement or N_Case_Statement node. This procedure sets + -- the End_Span field to correspond to the given value S. In other words, + -- End_Span is set to the difference between S and Sloc (N), the starting + -- location. + + function Get_Pragma_Arg (Arg : Node_Id) return Node_Id; + -- Given an argument to a pragma Arg, this function returns the expression + -- for the argument. This is Arg itself, or, in the case where Arg is a + -- pragma argument association node, the expression from this node. + + ----------------------- + -- Utility Functions -- + ----------------------- + + procedure Map_Pragma_Name (From, To : Name_Id); + -- Used in the implementation of pragma Rename_Pragma. Maps pragma name + -- From to pragma name To, so From can be used as a synonym for To. + + Too_Many_Pragma_Mappings : exception; + -- Raised if Map_Pragma_Name is called too many times. We expect that few + -- programs will use it at all, and those that do will use it approximately + -- once or twice. + + function Pragma_Name (N : Node_Id) return Name_Id; + -- Obtain the name of pragma N from the Chars field of its identifier. If + -- the pragma has been renamed using Rename_Pragma, this routine returns + -- the name of the renaming. + + function Pragma_Name_Unmapped (N : Node_Id) return Name_Id; + -- Obtain the name of pragma N from the Chars field of its identifier. This + -- form of name extraction does not take into account renamings performed + -- by Rename_Pragma. + + generic + with procedure Action (U : Union_Id); + procedure Walk_Sinfo_Fields (N : Node_Id); + -- Walk the Sinfo fields of N, for all field types that Union_Id includes, + -- and call Action on each one. However, skip the Link field, which is the + -- Parent, and would cause us to wander off into the weeds. ????It's not + -- clear why this should walk semantic fields. + + generic + with function Transform (U : Union_Id) return Union_Id; + procedure Walk_Sinfo_Fields_Pairwise (N1, N2 : Node_Id); + -- Walks the Sinfo fields of N1 and N2 pairwise, calls Tranform on each N2 + -- field, copying the resut into the corresponding field of N1. The Nkinds + -- must match. Link is skipped. + + ------------------------------------------- + -- Aliases for Entity_Or_Associated_Node -- + ------------------------------------------- + + -- Historically, the Entity, Associated_Node, and Entity_Or_Associated_Node + -- fields shared the same slot. A further complication is that there is an + -- N_Has_Entity that does not include all node types that have the Entity + -- field. + + subtype N_Really_Has_Entity is Node_Id with Predicate => + N_Really_Has_Entity in + N_Has_Entity_Id + | N_Attribute_Definition_Clause_Id + | N_Aspect_Specification_Id + | N_Freeze_Entity_Id + | N_Freeze_Generic_Entity_Id; + + subtype N_Has_Associated_Node is Node_Id with Predicate => + N_Has_Associated_Node in + N_Has_Entity_Id + | N_Aggregate_Id + | N_Extension_Aggregate_Id + | N_Selected_Component_Id + | N_Use_Package_Clause_Id; + + function Associated_Node + (N : N_Has_Associated_Node) return Node_Id + renames Entity_Or_Associated_Node; + + function Entity + (N : N_Really_Has_Entity) return Node_Id + renames Entity_Or_Associated_Node; + + procedure Set_Associated_Node + (N : N_Has_Associated_Node; Val : Node_Id) + renames Set_Entity_Or_Associated_Node; + + procedure Set_Entity + (N : N_Really_Has_Entity; Val : Node_Id) + renames Set_Entity_Or_Associated_Node; + + function Associated_Node return Node_Field renames + Entity_Or_Associated_Node; + function Entity return Node_Field renames + Entity_Or_Associated_Node; + -- Note that we are renaming the enumeration literals here + +end Sinfo.Utils; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 7a7f5455022..8c5c32a4f0a 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -23,7166 +23,4 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; - -package body Sinfo is - - use Atree.Unchecked_Access; - -- This package is one of the few packages which is allowed to make direct - -- references to tree nodes (since it is in the business of providing a - -- higher level of tree access which other clients are expected to use and - -- which implements checks). - - use Atree_Private_Part; - -- The only reason that we ask for direct access to the private part of - -- the tree package is so that we can directly reference the Nkind field - -- of nodes table entries. We do this since it helps the efficiency of - -- the Sinfo debugging checks considerably (note that when we are checking - -- Nkind values, we don't need to check for a valid node reference, because - -- we will check that anyway when we reference the field). - - NT : Nodes.Table_Ptr renames Nodes.Table; - -- A short hand abbreviation, useful for the debugging checks - - ---------------------------- - -- Field Access Functions -- - ---------------------------- - - -- Note: The use of Assert (False or else ...) is just a device to allow - -- uniform format of the conditions following this. Note that csinfo - -- expects this uniform format. - - function Abort_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Requeue_Statement); - return Flag15 (N); - end Abort_Present; - - function Abortable_Part - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Asynchronous_Select); - return Node2 (N); - end Abortable_Part; - - function Abstract_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition); - return Flag4 (N); - end Abstract_Present; - - function Accept_Handler_Records - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative); - return List5 (N); - end Accept_Handler_Records; - - function Accept_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative); - return Node2 (N); - end Accept_Statement; - - function Access_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration); - return Node3 (N); - end Access_Definition; - - function Access_To_Subprogram_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition); - return Node3 (N); - end Access_To_Subprogram_Definition; - - function Access_Types_To_Process - (N : Node_Id) return Elist_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Freeze_Entity); - return Elist2 (N); - end Access_Types_To_Process; - - function Actions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_And_Then - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Compilation_Unit_Aux - or else NT (N).Nkind = N_Compound_Statement - or else NT (N).Nkind = N_Expression_With_Actions - or else NT (N).Nkind = N_Freeze_Entity - or else NT (N).Nkind = N_Or_Else); - return List1 (N); - end Actions; - - function Activation_Chain_Entity - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - return Node3 (N); - end Activation_Chain_Entity; - - function Acts_As_Spec - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit - or else NT (N).Nkind = N_Subprogram_Body); - return Flag4 (N); - end Acts_As_Spec; - - function Actual_Designated_Subtype - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Explicit_Dereference - or else NT (N).Nkind = N_Free_Statement); - return Node4 (N); - end Actual_Designated_Subtype; - - function Address_Warning_Posted - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause); - return Flag18 (N); - end Address_Warning_Posted; - - function Aggregate_Bounds - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate); - return Node3 (N); - end Aggregate_Bounds; - - function Aliased_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - return Flag4 (N); - end Aliased_Present; - - function Alloc_For_BIP_Return - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - return Flag1 (N); - end Alloc_For_BIP_Return; - - function All_Others - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Others_Choice); - return Flag11 (N); - end All_Others; - - function All_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Quantified_Expression - or else NT (N).Nkind = N_Use_Type_Clause); - return Flag15 (N); - end All_Present; - - function Alternatives - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Expression - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In); - return List4 (N); - end Alternatives; - - function Ancestor_Part - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extension_Aggregate); - return Node3 (N); - end Ancestor_Part; - - function Atomic_Sync_Required - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Explicit_Dereference - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Indexed_Component - or else NT (N).Nkind = N_Selected_Component); - return Flag14 (N); - end Atomic_Sync_Required; - - function Array_Aggregate - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Enumeration_Representation_Clause); - return Node3 (N); - end Array_Aggregate; - - function Aspect_On_Partial_View - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification); - return Flag18 (N); - end Aspect_On_Partial_View; - - function Aspect_Rep_Item - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification); - return Node2 (N); - end Aspect_Rep_Item; - - function Assignment_OK - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind in N_Subexpr); - return Flag15 (N); - end Assignment_OK; - - function Associated_Node - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Entity - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate - or else NT (N).Nkind = N_Selected_Component - or else NT (N).Nkind = N_Use_Package_Clause); - return Node4 (N); - end Associated_Node; - - function At_End_Proc - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements); - return Node1 (N); - end At_End_Proc; - - function Attribute_Name - (N : Node_Id) return Name_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - return Name2 (N); - end Attribute_Name; - - function Aux_Decls_Node - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Node5 (N); - end Aux_Decls_Node; - - function Backwards_OK - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - return Flag6 (N); - end Backwards_OK; - - function Bad_Is_Detected - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - return Flag15 (N); - end Bad_Is_Detected; - - function Body_Required - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Flag13 (N); - end Body_Required; - - function Body_To_Inline - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Declaration); - return Node3 (N); - end Body_To_Inline; - - function Box_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Generic_Association - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association); - return Flag15 (N); - end Box_Present; - - function By_Ref - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - return Flag5 (N); - end By_Ref; - - function Char_Literal_Value - (N : Node_Id) return Uint is - begin - pragma Assert (False - or else NT (N).Nkind = N_Character_Literal); - return Uint2 (N); - end Char_Literal_Value; - - function Chars - (N : Node_Id) return Name_Id is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Chars); - return Name1 (N); - end Chars; - - function Check_Address_Alignment - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause); - return Flag11 (N); - end Check_Address_Alignment; - - function Choice_Parameter - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - return Node2 (N); - end Choice_Parameter; - - function Choices - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association); - return List1 (N); - end Choices; - - function Class_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - return Flag6 (N); - end Class_Present; - - function Classifications - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - return Node3 (N); - end Classifications; - - function Cleanup_Actions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - return List5 (N); - end Cleanup_Actions; - - function Comes_From_Extended_Return_Statement - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Simple_Return_Statement); - return Flag18 (N); - end Comes_From_Extended_Return_Statement; - - function Compile_Time_Known_Aggregate - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate); - return Flag18 (N); - end Compile_Time_Known_Aggregate; - - function Component_Associations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Delta_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - return List2 (N); - end Component_Associations; - - function Component_Clauses - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Record_Representation_Clause); - return List3 (N); - end Component_Clauses; - - function Component_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Constrained_Array_Definition - or else NT (N).Nkind = N_Unconstrained_Array_Definition); - return Node4 (N); - end Component_Definition; - - function Component_Items - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List); - return List3 (N); - end Component_Items; - - function Component_List - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_Variant); - return Node1 (N); - end Component_List; - - function Component_Name - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - return Node1 (N); - end Component_Name; - - function Componentwise_Assignment - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - return Flag14 (N); - end Componentwise_Assignment; - - function Condition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative - or else NT (N).Nkind = N_Delay_Alternative - or else NT (N).Nkind = N_Elsif_Part - or else NT (N).Nkind = N_Entry_Body_Formal_Part - or else NT (N).Nkind = N_Exit_Statement - or else NT (N).Nkind = N_If_Statement - or else NT (N).Nkind = N_Iteration_Scheme - or else NT (N).Nkind = N_Quantified_Expression - or else NT (N).Nkind = N_Raise_Constraint_Error - or else NT (N).Nkind = N_Raise_Program_Error - or else NT (N).Nkind = N_Raise_Storage_Error - or else NT (N).Nkind = N_Terminate_Alternative); - return Node1 (N); - end Condition; - - function Condition_Actions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Elsif_Part - or else NT (N).Nkind = N_Iteration_Scheme); - return List3 (N); - end Condition_Actions; - - function Config_Pragmas - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit_Aux); - return List4 (N); - end Config_Pragmas; - - function Constant_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Object_Declaration); - return Flag17 (N); - end Constant_Present; - - function Constraint - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subtype_Indication); - return Node3 (N); - end Constraint; - - function Constraints - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Index_Or_Discriminant_Constraint); - return List1 (N); - end Constraints; - - function Context_Installed - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag13 (N); - end Context_Installed; - - function Context_Items - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return List1 (N); - end Context_Items; - - function Context_Pending - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Flag16 (N); - end Context_Pending; - - function Contract_Test_Cases - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - return Node2 (N); - end Contract_Test_Cases; - - function Controlling_Argument - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - return Node1 (N); - end Controlling_Argument; - - function Conversion_OK - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Type_Conversion); - return Flag14 (N); - end Conversion_OK; - - function Convert_To_Return_False - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Raise_Expression); - return Flag13 (N); - end Convert_To_Return_False; - - function Corresponding_Aspect - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Node3 (N); - end Corresponding_Aspect; - - function Corresponding_Body - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Task_Body_Stub - or else NT (N).Nkind = N_Task_Type_Declaration); - return Node5 (N); - end Corresponding_Body; - - function Corresponding_Formal_Spec - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - return Node3 (N); - end Corresponding_Formal_Spec; - - function Corresponding_Generic_Association - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration); - return Node5 (N); - end Corresponding_Generic_Association; - - function Corresponding_Integer_Value - (N : Node_Id) return Uint is - begin - pragma Assert (False - or else NT (N).Nkind = N_Real_Literal); - return Uint4 (N); - end Corresponding_Integer_Value; - - function Corresponding_Spec - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Expression_Function - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration - or else NT (N).Nkind = N_Task_Body - or else NT (N).Nkind = N_With_Clause); - return Node5 (N); - end Corresponding_Spec; - - function Corresponding_Spec_Of_Stub - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Task_Body_Stub); - return Node2 (N); - end Corresponding_Spec_Of_Stub; - - function Corresponding_Stub - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subunit); - return Node3 (N); - end Corresponding_Stub; - - function Dcheck_Function - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant); - return Node5 (N); - end Dcheck_Function; - - function Declarations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Compilation_Unit_Aux - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - return List2 (N); - end Declarations; - - function Default_Expression - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - return Node5 (N); - end Default_Expression; - - function Default_Storage_Pool - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit_Aux); - return Node3 (N); - end Default_Storage_Pool; - - function Default_Name - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration); - return Node2 (N); - end Default_Name; - - function Defining_Identifier - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Defining_Program_Unit_Name - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Entry_Index_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Exception_Renaming_Declaration - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Formal_Type_Declaration - or else NT (N).Nkind = N_Full_Type_Declaration - or else NT (N).Nkind = N_Implicit_Label_Declaration - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Single_Protected_Declaration - or else NT (N).Nkind = N_Single_Task_Declaration - or else NT (N).Nkind = N_Subtype_Declaration - or else NT (N).Nkind = N_Task_Body - or else NT (N).Nkind = N_Task_Body_Stub - or else NT (N).Nkind = N_Task_Type_Declaration); - return Node1 (N); - end Defining_Identifier; - - function Defining_Unit_Name - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Generic_Function_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Package_Renaming_Declaration - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Procedure_Specification); - return Node1 (N); - end Defining_Unit_Name; - - function Delay_Alternative - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Timed_Entry_Call); - return Node4 (N); - end Delay_Alternative; - - function Delay_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Delay_Alternative); - return Node2 (N); - end Delay_Statement; - - function Delta_Expression - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Decimal_Fixed_Point_Definition - or else NT (N).Nkind = N_Delta_Constraint - or else NT (N).Nkind = N_Ordinary_Fixed_Point_Definition); - return Node3 (N); - end Delta_Expression; - - function Digits_Expression - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Decimal_Fixed_Point_Definition - or else NT (N).Nkind = N_Digits_Constraint - or else NT (N).Nkind = N_Floating_Point_Definition); - return Node2 (N); - end Digits_Expression; - - function Discr_Check_Funcs_Built - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Full_Type_Declaration); - return Flag11 (N); - end Discr_Check_Funcs_Built; - - function Discrete_Choices - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Case_Statement_Alternative - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Variant); - return List4 (N); - end Discrete_Choices; - - function Discrete_Range - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Slice); - return Node4 (N); - end Discrete_Range; - - function Discrete_Subtype_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Entry_Index_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification); - return Node4 (N); - end Discrete_Subtype_Definition; - - function Discrete_Subtype_Definitions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Constrained_Array_Definition); - return List2 (N); - end Discrete_Subtype_Definitions; - - function Discriminant_Specifications - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Type_Declaration - or else NT (N).Nkind = N_Full_Type_Declaration - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Task_Type_Declaration); - return List4 (N); - end Discriminant_Specifications; - - function Discriminant_Type - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Discriminant_Specification); - return Node5 (N); - end Discriminant_Type; - - function Do_Accessibility_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Specification); - return Flag13 (N); - end Do_Accessibility_Check; - - function Do_Discriminant_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Selected_Component - or else NT (N).Nkind = N_Type_Conversion); - return Flag3 (N); - end Do_Discriminant_Check; - - function Do_Division_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Divide - or else NT (N).Nkind = N_Op_Mod - or else NT (N).Nkind = N_Op_Rem); - return Flag13 (N); - end Do_Division_Check; - - function Do_Length_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Op_And - or else NT (N).Nkind = N_Op_Or - or else NT (N).Nkind = N_Op_Xor - or else NT (N).Nkind = N_Type_Conversion); - return Flag4 (N); - end Do_Length_Check; - - function Do_Overflow_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Op - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Case_Expression - or else NT (N).Nkind = N_If_Expression - or else NT (N).Nkind = N_Type_Conversion); - return Flag17 (N); - end Do_Overflow_Check; - - function Do_Range_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - return Flag9 (N); - end Do_Range_Check; - - function Do_Storage_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Subprogram_Body); - return Flag17 (N); - end Do_Storage_Check; - - function Do_Tag_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Simple_Return_Statement - or else NT (N).Nkind = N_Type_Conversion); - return Flag13 (N); - end Do_Tag_Check; - - function Elaborate_All_Desirable - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag9 (N); - end Elaborate_All_Desirable; - - function Elaborate_All_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag14 (N); - end Elaborate_All_Present; - - function Elaborate_Desirable - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag11 (N); - end Elaborate_Desirable; - - function Elaborate_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag4 (N); - end Elaborate_Present; - - function Else_Actions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Expression); - return List3 (N); - end Else_Actions; - - function Else_Statements - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Conditional_Entry_Call - or else NT (N).Nkind = N_If_Statement - or else NT (N).Nkind = N_Selective_Accept); - return List4 (N); - end Else_Statements; - - function Elsif_Parts - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Statement); - return List3 (N); - end Elsif_Parts; - - function Enclosing_Variant - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant); - return Node2 (N); - end Enclosing_Variant; - - function End_Label - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Enumeration_Type_Definition - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements - or else NT (N).Nkind = N_Loop_Statement - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Protected_Definition - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_Task_Definition); - return Node4 (N); - end End_Label; - - function End_Span - (N : Node_Id) return Uint is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_If_Statement); - return Uint5 (N); - end End_Span; - - function Entity - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Entity - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Freeze_Entity - or else NT (N).Nkind = N_Freeze_Generic_Entity); - return Node4 (N); - end Entity; - - function Entity_Or_Associated_Node - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Entity - or else NT (N).Nkind = N_Freeze_Entity); - return Node4 (N); - end Entity_Or_Associated_Node; - - function Entry_Body_Formal_Part - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Body); - return Node5 (N); - end Entry_Body_Formal_Part; - - function Entry_Call_Alternative - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Conditional_Entry_Call - or else NT (N).Nkind = N_Timed_Entry_Call); - return Node1 (N); - end Entry_Call_Alternative; - - function Entry_Call_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Call_Alternative); - return Node1 (N); - end Entry_Call_Statement; - - function Entry_Direct_Name - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement); - return Node1 (N); - end Entry_Direct_Name; - - function Entry_Index - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement); - return Node5 (N); - end Entry_Index; - - function Entry_Index_Specification - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Body_Formal_Part); - return Node4 (N); - end Entry_Index_Specification; - - function Etype - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Etype); - return Node5 (N); - end Etype; - - function Exception_Choices - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - return List4 (N); - end Exception_Choices; - - function Exception_Handlers - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements); - return List5 (N); - end Exception_Handlers; - - function Exception_Junk - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Goto_Statement - or else NT (N).Nkind = N_Label - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Subtype_Declaration); - return Flag8 (N); - end Exception_Junk; - - function Exception_Label - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler - or else NT (N).Nkind = N_Push_Constraint_Error_Label - or else NT (N).Nkind = N_Push_Program_Error_Label - or else NT (N).Nkind = N_Push_Storage_Error_Label); - return Node5 (N); - end Exception_Label; - - function Expansion_Delayed - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - return Flag11 (N); - end Expansion_Delayed; - - function Explicit_Actual_Parameter - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Association); - return Node3 (N); - end Explicit_Actual_Parameter; - - function Explicit_Generic_Actual_Parameter - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Generic_Association); - return Node1 (N); - end Explicit_Generic_Actual_Parameter; - - function Expression - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_At_Clause - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Case_Expression - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_Code_Statement - or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Delay_Relative_Statement - or else NT (N).Nkind = N_Delay_Until_Statement - or else NT (N).Nkind = N_Delta_Aggregate - or else NT (N).Nkind = N_Discriminant_Association - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Expression_Function - or else NT (N).Nkind = N_Expression_With_Actions - or else NT (N).Nkind = N_Free_Statement - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association - or else NT (N).Nkind = N_Mod_Clause - or else NT (N).Nkind = N_Modular_Type_Definition - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Pragma_Argument_Association - or else NT (N).Nkind = N_Qualified_Expression - or else NT (N).Nkind = N_Raise_Expression - or else NT (N).Nkind = N_Raise_Statement - or else NT (N).Nkind = N_Simple_Return_Statement - or else NT (N).Nkind = N_Type_Conversion - or else NT (N).Nkind = N_Unchecked_Expression - or else NT (N).Nkind = N_Unchecked_Type_Conversion); - return Node3 (N); - end Expression; - - function Expression_Copy - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma_Argument_Association); - return Node2 (N); - end Expression_Copy; - - function Expressions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Extension_Aggregate - or else NT (N).Nkind = N_If_Expression - or else NT (N).Nkind = N_Indexed_Component); - return List1 (N); - end Expressions; - - function First_Bit - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - return Node3 (N); - end First_Bit; - - function First_Inlined_Subprogram - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Node3 (N); - end First_Inlined_Subprogram; - - function First_Name - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag5 (N); - end First_Name; - - function First_Named_Actual - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - return Node4 (N); - end First_Named_Actual; - - function First_Real_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements); - return Node2 (N); - end First_Real_Statement; - - function First_Subtype_Link - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Freeze_Entity); - return Node5 (N); - end First_Subtype_Link; - - function Float_Truncate - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Type_Conversion); - return Flag11 (N); - end Float_Truncate; - - function Formal_Type_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Type_Declaration); - return Node3 (N); - end Formal_Type_Definition; - - function Forwards_OK - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - return Flag5 (N); - end Forwards_OK; - - function From_Aspect_Specification - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Pragma); - return Flag13 (N); - end From_Aspect_Specification; - - function From_At_End - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Raise_Statement); - return Flag4 (N); - end From_At_End; - - function From_At_Mod - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause); - return Flag4 (N); - end From_At_Mod; - - function From_Conditional_Expression - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_If_Statement); - return Flag1 (N); - end From_Conditional_Expression; - - function From_Default - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - return Flag6 (N); - end From_Default; - - function Generalized_Indexing - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Indexed_Component); - return Node4 (N); - end Generalized_Indexing; - - function Generic_Associations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - return List3 (N); - end Generic_Associations; - - function Generic_Formal_Declarations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration); - return List2 (N); - end Generic_Formal_Declarations; - - function Generic_Parent - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Procedure_Specification); - return Node5 (N); - end Generic_Parent; - - function Generic_Parent_Type - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subtype_Declaration); - return Node4 (N); - end Generic_Parent_Type; - - function Handled_Statement_Sequence - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - return Node4 (N); - end Handled_Statement_Sequence; - - function Handler_List_Entry - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - return Node2 (N); - end Handler_List_Entry; - - function Has_Created_Identifier - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Loop_Statement); - return Flag15 (N); - end Has_Created_Identifier; - - function Has_Dereference_Action - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Explicit_Dereference); - return Flag13 (N); - end Has_Dereference_Action; - - function Has_Dynamic_Length_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - return Flag10 (N); - end Has_Dynamic_Length_Check; - - function Has_Init_Expression - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - return Flag14 (N); - end Has_Init_Expression; - - function Has_Local_Raise - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - return Flag8 (N); - end Has_Local_Raise; - - function Has_No_Elaboration_Code - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Flag17 (N); - end Has_No_Elaboration_Code; - - function Has_Pragma_Suppress_All - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Flag14 (N); - end Has_Pragma_Suppress_All; - - function Has_Private_View - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Op - or else NT (N).Nkind = N_Character_Literal - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Operator_Symbol); - return Flag11 (N); - end Has_Private_View; - - function Has_Relative_Deadline_Pragma - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Definition); - return Flag9 (N); - end Has_Relative_Deadline_Pragma; - - function Has_Self_Reference - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - return Flag13 (N); - end Has_Self_Reference; - - function Has_SP_Choice - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Case_Statement_Alternative - or else NT (N).Nkind = N_Variant); - return Flag15 (N); - end Has_SP_Choice; - - function Has_Storage_Size_Pragma - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Task_Definition); - return Flag5 (N); - end Has_Storage_Size_Pragma; - - function Has_Target_Names - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - return Flag8 (N); - end Has_Target_Names; - - function Has_Wide_Character - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_String_Literal); - return Flag11 (N); - end Has_Wide_Character; - - function Has_Wide_Wide_Character - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_String_Literal); - return Flag13 (N); - end Has_Wide_Wide_Character; - - function Header_Size_Added - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - return Flag11 (N); - end Header_Size_Added; - - function Hidden_By_Use_Clause - (N : Node_Id) return Elist_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - return Elist5 (N); - end Hidden_By_Use_Clause; - - function High_Bound - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range - or else NT (N).Nkind = N_Real_Range_Specification - or else NT (N).Nkind = N_Signed_Integer_Type_Definition); - return Node2 (N); - end High_Bound; - - function Identifier - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_At_Clause - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Designator - or else NT (N).Nkind = N_Enumeration_Representation_Clause - or else NT (N).Nkind = N_Label - or else NT (N).Nkind = N_Loop_Statement - or else NT (N).Nkind = N_Record_Representation_Clause); - return Node1 (N); - end Identifier; - - function Implicit_With - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag16 (N); - end Implicit_With; - - function Interface_List - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_Single_Protected_Declaration - or else NT (N).Nkind = N_Single_Task_Declaration - or else NT (N).Nkind = N_Task_Type_Declaration); - return List2 (N); - end Interface_List; - - function Interface_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Record_Definition); - return Flag16 (N); - end Interface_Present; - - function Import_Interface_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag16 (N); - end Import_Interface_Present; - - function In_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - return Flag15 (N); - end In_Present; - - function Includes_Infinities - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range); - return Flag11 (N); - end Includes_Infinities; - - function Incomplete_View - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Full_Type_Declaration); - return Node2 (N); - end Incomplete_View; - - function Inherited_Discriminant - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association); - return Flag13 (N); - end Inherited_Discriminant; - - function Instance_Spec - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - return Node5 (N); - end Instance_Spec; - - function Intval - (N : Node_Id) return Uint is - begin - pragma Assert (False - or else NT (N).Nkind = N_Integer_Literal); - return Uint3 (N); - end Intval; - - function Is_Abort_Block - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - return Flag4 (N); - end Is_Abort_Block; - - function Is_Accessibility_Actual - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Association); - return Flag13 (N); - end Is_Accessibility_Actual; - - function Is_Analyzed_Pragma - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag5 (N); - end Is_Analyzed_Pragma; - - function Is_Asynchronous_Call_Block - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - return Flag7 (N); - end Is_Asynchronous_Call_Block; - - function Is_Boolean_Aspect - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification); - return Flag16 (N); - end Is_Boolean_Aspect; - - function Is_Checked - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - return Flag11 (N); - end Is_Checked; - - function Is_Checked_Ghost_Pragma - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag3 (N); - end Is_Checked_Ghost_Pragma; - - function Is_Component_Left_Opnd - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Concat); - return Flag13 (N); - end Is_Component_Left_Opnd; - - function Is_Component_Right_Opnd - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Concat); - return Flag14 (N); - end Is_Component_Right_Opnd; - - function Is_Controlling_Actual - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - return Flag16 (N); - end Is_Controlling_Actual; - - function Is_Declaration_Level_Node - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - return Flag5 (N); - end Is_Declaration_Level_Node; - - function Is_Delayed_Aspect - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Pragma); - return Flag14 (N); - end Is_Delayed_Aspect; - - function Is_Disabled - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - return Flag15 (N); - end Is_Disabled; - - function Is_Dispatching_Call - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); - return Flag6 (N); - end Is_Dispatching_Call; - - function Is_Dynamic_Coextension - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - return Flag18 (N); - end Is_Dynamic_Coextension; - - function Is_Effective_Use_Clause - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - return Flag1 (N); - end Is_Effective_Use_Clause; - - function Is_Elaboration_Checks_OK_Node - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Variable_Reference_Marker); - return Flag1 (N); - end Is_Elaboration_Checks_OK_Node; - - function Is_Elaboration_Code - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - return Flag9 (N); - end Is_Elaboration_Code; - - function Is_Elaboration_Warnings_OK_Node - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Variable_Reference_Marker); - return Flag3 (N); - end Is_Elaboration_Warnings_OK_Node; - - function Is_Elsif - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Expression); - return Flag13 (N); - end Is_Elsif; - - function Is_Entry_Barrier_Function - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Declaration); - return Flag8 (N); - end Is_Entry_Barrier_Function; - - function Is_Expanded_Build_In_Place_Call - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call); - return Flag11 (N); - end Is_Expanded_Build_In_Place_Call; - - function Is_Expanded_Contract - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - return Flag1 (N); - end Is_Expanded_Contract; - - function Is_Finalization_Wrapper - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - return Flag9 (N); - end Is_Finalization_Wrapper; - - function Is_Folded_In_Parser - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_String_Literal); - return Flag4 (N); - end Is_Folded_In_Parser; - - function Is_Generic_Contract_Pragma - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag2 (N); - end Is_Generic_Contract_Pragma; - - function Is_Homogeneous_Aggregate - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate); - return Flag14 (N); - end Is_Homogeneous_Aggregate; - - function Is_Ignored - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - return Flag9 (N); - end Is_Ignored; - - function Is_Ignored_Ghost_Pragma - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag8 (N); - end Is_Ignored_Ghost_Pragma; - - function Is_In_Discriminant_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Selected_Component); - return Flag11 (N); - end Is_In_Discriminant_Check; - - function Is_Inherited_Pragma - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag4 (N); - end Is_Inherited_Pragma; - - function Is_Initialization_Block - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - return Flag1 (N); - end Is_Initialization_Block; - - function Is_Known_Guaranteed_ABE - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation); - return Flag18 (N); - end Is_Known_Guaranteed_ABE; - - function Is_Machine_Number - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Real_Literal); - return Flag11 (N); - end Is_Machine_Number; - - function Is_Null_Loop - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Loop_Statement); - return Flag16 (N); - end Is_Null_Loop; - - function Is_Overloaded - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - return Flag5 (N); - end Is_Overloaded; - - function Is_Power_Of_2_For_Shift - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Expon); - return Flag13 (N); - end Is_Power_Of_2_For_Shift; - - function Is_Preelaborable_Call - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); - return Flag7 (N); - end Is_Preelaborable_Call; - - function Is_Prefixed_Call - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Selected_Component); - return Flag17 (N); - end Is_Prefixed_Call; - - function Is_Protected_Subprogram_Body - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - return Flag7 (N); - end Is_Protected_Subprogram_Body; - - function Is_Qualified_Universal_Literal - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Qualified_Expression); - return Flag4 (N); - end Is_Qualified_Universal_Literal; - - function Is_Read - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variable_Reference_Marker); - return Flag4 (N); - end Is_Read; - - function Is_Source_Call - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); - return Flag4 (N); - end Is_Source_Call; - - function Is_SPARK_Mode_On_Node - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Variable_Reference_Marker); - return Flag2 (N); - end Is_SPARK_Mode_On_Node; - - function Is_Static_Coextension - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - return Flag14 (N); - end Is_Static_Coextension; - - function Is_Static_Expression - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - return Flag6 (N); - end Is_Static_Expression; - - function Is_Subprogram_Descriptor - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - return Flag16 (N); - end Is_Subprogram_Descriptor; - - function Is_Task_Allocation_Block - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - return Flag6 (N); - end Is_Task_Allocation_Block; - - function Is_Task_Body_Procedure - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Declaration); - return Flag1 (N); - end Is_Task_Body_Procedure; - - function Is_Task_Master - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - return Flag5 (N); - end Is_Task_Master; - - function Is_Write - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variable_Reference_Marker); - return Flag5 (N); - end Is_Write; - - function Iterator_Filter - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification); - return Node3 (N); - end Iterator_Filter; - - function Iteration_Scheme - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Loop_Statement); - return Node2 (N); - end Iteration_Scheme; - - function Iterator_Specification - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association - or else NT (N).Nkind = N_Iteration_Scheme - or else NT (N).Nkind = N_Quantified_Expression); - return Node2 (N); - end Iterator_Specification; - - function Itype - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Itype_Reference); - return Node1 (N); - end Itype; - - function Key_Expression - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterated_Element_Association); - return Node1 (N); - end Key_Expression; - - function Kill_Range_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Unchecked_Type_Conversion); - return Flag11 (N); - end Kill_Range_Check; - - function Label_Construct - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Implicit_Label_Declaration); - return Node2 (N); - end Label_Construct; - - function Last_Bit - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - return Node4 (N); - end Last_Bit; - - function Last_Name - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag6 (N); - end Last_Name; - - function Left_Opnd - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_And_Then - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In - or else NT (N).Nkind = N_Or_Else - or else NT (N).Nkind in N_Binary_Op); - return Node2 (N); - end Left_Opnd; - - function Library_Unit - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Task_Body_Stub - or else NT (N).Nkind = N_With_Clause); - return Node4 (N); - end Library_Unit; - - function Limited_View_Installed - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_With_Clause); - return Flag18 (N); - end Limited_View_Installed; - - function Limited_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_With_Clause); - return Flag17 (N); - end Limited_Present; - - function Literals - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Enumeration_Type_Definition); - return List1 (N); - end Literals; - - function Local_Raise_Not_OK - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - return Flag7 (N); - end Local_Raise_Not_OK; - - function Local_Raise_Statements - (N : Node_Id) return Elist_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - return Elist1 (N); - end Local_Raise_Statements; - - function Loop_Actions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association); - return List5 (N); - end Loop_Actions; - - function Loop_Parameter_Specification - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterated_Element_Association - or else NT (N).Nkind = N_Iteration_Scheme - or else NT (N).Nkind = N_Quantified_Expression); - return Node4 (N); - end Loop_Parameter_Specification; - - function Low_Bound - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range - or else NT (N).Nkind = N_Real_Range_Specification - or else NT (N).Nkind = N_Signed_Integer_Type_Definition); - return Node1 (N); - end Low_Bound; - - function Mod_Clause - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Record_Representation_Clause); - return Node2 (N); - end Mod_Clause; - - function More_Ids - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - return Flag5 (N); - end More_Ids; - - function Must_Be_Byte_Aligned - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - return Flag14 (N); - end Must_Be_Byte_Aligned; - - function Must_Not_Freeze - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subtype_Indication - or else NT (N).Nkind in N_Subexpr); - return Flag8 (N); - end Must_Not_Freeze; - - function Must_Not_Override - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Procedure_Specification); - return Flag15 (N); - end Must_Not_Override; - - function Must_Override - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Procedure_Specification); - return Flag14 (N); - end Must_Override; - - function Name - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Defining_Program_Unit_Name - or else NT (N).Nkind = N_Designator - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Exception_Renaming_Declaration - or else NT (N).Nkind = N_Exit_Statement - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Generic_Function_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration - or else NT (N).Nkind = N_Goto_Statement - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Package_Renaming_Declaration - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Raise_Expression - or else NT (N).Nkind = N_Raise_Statement - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration - or else NT (N).Nkind = N_Subunit - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Variant_Part - or else NT (N).Nkind = N_With_Clause); - return Node2 (N); - end Name; - - function Names - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Abort_Statement); - return List2 (N); - end Names; - - function Next_Entity - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Defining_Character_Literal - or else NT (N).Nkind = N_Defining_Identifier - or else NT (N).Nkind = N_Defining_Operator_Symbol); - return Node2 (N); - end Next_Entity; - - function Next_Exit_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exit_Statement); - return Node3 (N); - end Next_Exit_Statement; - - function Next_Implicit_With - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Node3 (N); - end Next_Implicit_With; - - function Next_Named_Actual - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Association); - return Node4 (N); - end Next_Named_Actual; - - function Next_Pragma - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Node1 (N); - end Next_Pragma; - - function Next_Rep_Item - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Enumeration_Representation_Clause - or else NT (N).Nkind = N_Null_Statement - or else NT (N).Nkind = N_Pragma - or else NT (N).Nkind = N_Record_Representation_Clause); - return Node5 (N); - end Next_Rep_Item; - - function Next_Use_Clause - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - return Node3 (N); - end Next_Use_Clause; - - function No_Ctrl_Actions - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - return Flag7 (N); - end No_Ctrl_Actions; - - function No_Elaboration_Check - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - return Flag4 (N); - end No_Elaboration_Check; - - function No_Entities_Ref_In_Spec - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag8 (N); - end No_Entities_Ref_In_Spec; - - function No_Initialization - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Object_Declaration); - return Flag13 (N); - end No_Initialization; - - function No_Minimize_Eliminate - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In); - return Flag17 (N); - end No_Minimize_Eliminate; - - function No_Side_Effect_Removal - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call); - return Flag17 (N); - end No_Side_Effect_Removal; - - function No_Truncation - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Unchecked_Type_Conversion); - return Flag17 (N); - end No_Truncation; - - function Null_Excluding_Subtype - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_To_Object_Definition); - return Flag16 (N); - end Null_Excluding_Subtype; - - function Null_Exclusion_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Subtype_Declaration); - return Flag11 (N); - end Null_Exclusion_Present; - - function Null_Exclusion_In_Return_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Function_Definition); - return Flag14 (N); - end Null_Exclusion_In_Return_Present; - - function Null_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List - or else NT (N).Nkind = N_Procedure_Specification - or else NT (N).Nkind = N_Record_Definition); - return Flag13 (N); - end Null_Present; - - function Null_Record_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - return Flag17 (N); - end Null_Record_Present; - - function Null_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Procedure_Specification); - return Node2 (N); - end Null_Statement; - - function Object_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - return Node4 (N); - end Object_Definition; - - function Of_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterator_Specification); - return Flag16 (N); - end Of_Present; - - function Original_Discriminant - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Identifier); - return Node2 (N); - end Original_Discriminant; - - function Original_Entity - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Integer_Literal - or else NT (N).Nkind = N_Real_Literal); - return Node2 (N); - end Original_Entity; - - function Others_Discrete_Choices - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Others_Choice); - return List1 (N); - end Others_Discrete_Choices; - - function Out_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - return Flag17 (N); - end Out_Present; - - function Parameter_Associations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - return List3 (N); - end Parameter_Associations; - - function Parameter_Specifications - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition - or else NT (N).Nkind = N_Entry_Body_Formal_Part - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Specification); - return List3 (N); - end Parameter_Specifications; - - function Parameter_Type - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Specification); - return Node2 (N); - end Parameter_Type; - - function Parent_Spec - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Generic_Function_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Package_Renaming_Declaration - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - return Node4 (N); - end Parent_Spec; - - function Parent_With - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag1 (N); - end Parent_With; - - function Position - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - return Node2 (N); - end Position; - - function Pragma_Argument_Associations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return List2 (N); - end Pragma_Argument_Associations; - - function Pragma_Identifier - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Node4 (N); - end Pragma_Identifier; - - function Pragmas_After - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit_Aux - or else NT (N).Nkind = N_Terminate_Alternative); - return List5 (N); - end Pragmas_After; - - function Pragmas_Before - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative - or else NT (N).Nkind = N_Delay_Alternative - or else NT (N).Nkind = N_Entry_Call_Alternative - or else NT (N).Nkind = N_Mod_Clause - or else NT (N).Nkind = N_Terminate_Alternative - or else NT (N).Nkind = N_Triggering_Alternative); - return List4 (N); - end Pragmas_Before; - - function Pre_Post_Conditions - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - return Node1 (N); - end Pre_Post_Conditions; - - function Prefix - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Explicit_Dereference - or else NT (N).Nkind = N_Indexed_Component - or else NT (N).Nkind = N_Reference - or else NT (N).Nkind = N_Selected_Component - or else NT (N).Nkind = N_Slice); - return Node3 (N); - end Prefix; - - function Premature_Use - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Incomplete_Type_Declaration); - return Node5 (N); - end Premature_Use; - - function Present_Expr - (N : Node_Id) return Uint is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant); - return Uint3 (N); - end Present_Expr; - - function Prev_Ids - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - return Flag6 (N); - end Prev_Ids; - - function Prev_Use_Clause - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - return Node1 (N); - end Prev_Use_Clause; - - function Print_In_Hex - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Integer_Literal); - return Flag13 (N); - end Print_In_Hex; - - function Private_Declarations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Protected_Definition - or else NT (N).Nkind = N_Task_Definition); - return List3 (N); - end Private_Declarations; - - function Private_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_With_Clause); - return Flag15 (N); - end Private_Present; - - function Procedure_To_Call - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Free_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - return Node2 (N); - end Procedure_To_Call; - - function Proper_Body - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subunit); - return Node1 (N); - end Proper_Body; - - function Protected_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Single_Protected_Declaration); - return Node3 (N); - end Protected_Definition; - - function Protected_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Record_Definition); - return Flag6 (N); - end Protected_Present; - - function Raises_Constraint_Error - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - return Flag7 (N); - end Raises_Constraint_Error; - - function Range_Constraint - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Delta_Constraint - or else NT (N).Nkind = N_Digits_Constraint); - return Node4 (N); - end Range_Constraint; - - function Range_Expression - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range_Constraint); - return Node4 (N); - end Range_Expression; - - function Real_Range_Specification - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Decimal_Fixed_Point_Definition - or else NT (N).Nkind = N_Floating_Point_Definition - or else NT (N).Nkind = N_Ordinary_Fixed_Point_Definition); - return Node4 (N); - end Real_Range_Specification; - - function Realval - (N : Node_Id) return Ureal is - begin - pragma Assert (False - or else NT (N).Nkind = N_Real_Literal); - return Ureal3 (N); - end Realval; - - function Reason - (N : Node_Id) return Uint is - begin - pragma Assert (False - or else NT (N).Nkind = N_Raise_Constraint_Error - or else NT (N).Nkind = N_Raise_Program_Error - or else NT (N).Nkind = N_Raise_Storage_Error); - return Uint3 (N); - end Reason; - - function Record_Extension_Part - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition); - return Node3 (N); - end Record_Extension_Part; - - function Redundant_Use - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Identifier); - return Flag13 (N); - end Redundant_Use; - - function Renaming_Exception - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Declaration); - return Node2 (N); - end Renaming_Exception; - - function Result_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Function_Specification); - return Node4 (N); - end Result_Definition; - - function Return_Object_Declarations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extended_Return_Statement); - return List3 (N); - end Return_Object_Declarations; - - function Return_Statement_Entity - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - return Node5 (N); - end Return_Statement_Entity; - - function Reverse_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification); - return Flag15 (N); - end Reverse_Present; - - function Right_Opnd - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind in N_Op - or else NT (N).Nkind = N_And_Then - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In - or else NT (N).Nkind = N_Or_Else); - return Node3 (N); - end Right_Opnd; - - function Rounded_Result - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Divide - or else NT (N).Nkind = N_Op_Multiply - or else NT (N).Nkind = N_Type_Conversion); - return Flag18 (N); - end Rounded_Result; - - function Save_Invocation_Graph_Of_Body - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Flag1 (N); - end Save_Invocation_Graph_Of_Body; - - function SCIL_Controlling_Tag - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Dispatching_Call); - return Node5 (N); - end SCIL_Controlling_Tag; - - function SCIL_Entity - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Dispatch_Table_Tag_Init - or else NT (N).Nkind = N_SCIL_Dispatching_Call - or else NT (N).Nkind = N_SCIL_Membership_Test); - return Node4 (N); - end SCIL_Entity; - - function SCIL_Tag_Value - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Membership_Test); - return Node5 (N); - end SCIL_Tag_Value; - - function SCIL_Target_Prim - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Dispatching_Call); - return Node2 (N); - end SCIL_Target_Prim; - - function Scope - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Defining_Character_Literal - or else NT (N).Nkind = N_Defining_Identifier - or else NT (N).Nkind = N_Defining_Operator_Symbol); - return Node3 (N); - end Scope; - - function Select_Alternatives - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Selective_Accept); - return List1 (N); - end Select_Alternatives; - - function Selector_Name - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Generic_Association - or else NT (N).Nkind = N_Parameter_Association - or else NT (N).Nkind = N_Selected_Component); - return Node2 (N); - end Selector_Name; - - function Selector_Names - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Discriminant_Association); - return List1 (N); - end Selector_Names; - - function Shift_Count_OK - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Rotate_Left - or else NT (N).Nkind = N_Op_Rotate_Right - or else NT (N).Nkind = N_Op_Shift_Left - or else NT (N).Nkind = N_Op_Shift_Right - or else NT (N).Nkind = N_Op_Shift_Right_Arithmetic); - return Flag4 (N); - end Shift_Count_OK; - - function Source_Type - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Validate_Unchecked_Conversion); - return Node1 (N); - end Source_Type; - - function Specification - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Expression_Function - or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - return Node1 (N); - end Specification; - - function Split_PPC - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - return Flag17 (N); - end Split_PPC; - - function Statements - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Abortable_Part - or else NT (N).Nkind = N_Accept_Alternative - or else NT (N).Nkind = N_Case_Statement_Alternative - or else NT (N).Nkind = N_Delay_Alternative - or else NT (N).Nkind = N_Entry_Call_Alternative - or else NT (N).Nkind = N_Exception_Handler - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements - or else NT (N).Nkind = N_Loop_Statement - or else NT (N).Nkind = N_Triggering_Alternative); - return List3 (N); - end Statements; - - function Storage_Pool - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Free_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - return Node1 (N); - end Storage_Pool; - - function Subpool_Handle_Name - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - return Node4 (N); - end Subpool_Handle_Name; - - function Strval - (N : Node_Id) return String_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Operator_Symbol - or else NT (N).Nkind = N_String_Literal); - return Str3 (N); - end Strval; - - function Subtype_Indication - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Subtype_Declaration); - return Node5 (N); - end Subtype_Indication; - - function Suppress_Assignment_Checks - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Object_Declaration); - return Flag18 (N); - end Suppress_Assignment_Checks; - - function Suppress_Loop_Warnings - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Loop_Statement); - return Flag17 (N); - end Suppress_Loop_Warnings; - - function Subtype_Mark - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Qualified_Expression - or else NT (N).Nkind = N_Subtype_Indication - or else NT (N).Nkind = N_Type_Conversion - or else NT (N).Nkind = N_Unchecked_Type_Conversion - or else NT (N).Nkind = N_Use_Type_Clause); - return Node4 (N); - end Subtype_Mark; - - function Subtype_Marks - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Unconstrained_Array_Definition); - return List2 (N); - end Subtype_Marks; - - function Synchronized_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Record_Definition); - return Flag7 (N); - end Synchronized_Present; - - function Tagged_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Incomplete_Type_Definition - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition); - return Flag15 (N); - end Tagged_Present; - - function Target - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Variable_Reference_Marker); - return Node1 (N); - end Target; - - function Target_Type - (N : Node_Id) return Entity_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Validate_Unchecked_Conversion); - return Node2 (N); - end Target_Type; - - function Task_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Single_Task_Declaration - or else NT (N).Nkind = N_Task_Type_Declaration); - return Node3 (N); - end Task_Definition; - - function Task_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Record_Definition); - return Flag5 (N); - end Task_Present; - - function Then_Actions - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Expression); - return List2 (N); - end Then_Actions; - - function Then_Statements - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Elsif_Part - or else NT (N).Nkind = N_If_Statement); - return List2 (N); - end Then_Statements; - - function Triggering_Alternative - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Asynchronous_Select); - return Node1 (N); - end Triggering_Alternative; - - function Triggering_Statement - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Triggering_Alternative); - return Node1 (N); - end Triggering_Statement; - - function TSS_Elist - (N : Node_Id) return Elist_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Freeze_Entity); - return Elist3 (N); - end TSS_Elist; - - function Type_Definition - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Full_Type_Declaration); - return Node3 (N); - end Type_Definition; - - function Uneval_Old_Accept - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag7 (N); - end Uneval_Old_Accept; - - function Uneval_Old_Warn - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag18 (N); - end Uneval_Old_Warn; - - function Unit - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - return Node2 (N); - end Unit; - - function Unknown_Discriminants_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Type_Declaration - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration); - return Flag13 (N); - end Unknown_Discriminants_Present; - - function Unreferenced_In_Spec - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - return Flag7 (N); - end Unreferenced_In_Spec; - - function Variant_Part - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List); - return Node4 (N); - end Variant_Part; - - function Variants - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant_Part); - return List1 (N); - end Variants; - - function Visible_Declarations - (N : Node_Id) return List_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Protected_Definition - or else NT (N).Nkind = N_Task_Definition); - return List2 (N); - end Visible_Declarations; - - function Uninitialized_Variable - (N : Node_Id) return Node_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration); - return Node3 (N); - end Uninitialized_Variable; - - function Used_Operations - (N : Node_Id) return Elist_Id is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Type_Clause); - return Elist2 (N); - end Used_Operations; - - function Was_Attribute_Reference - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - return Flag2 (N); - end Was_Attribute_Reference; - - function Was_Default_Init_Box_Association - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association); - return Flag14 (N); - end Was_Default_Init_Box_Association; - - function Was_Expression_Function - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - return Flag18 (N); - end Was_Expression_Function; - - function Was_Originally_Stub - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - return Flag13 (N); - end Was_Originally_Stub; - - -------------------------- - -- Field Set Procedures -- - -------------------------- - - procedure Set_Abort_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Requeue_Statement); - Set_Flag15 (N, Val); - end Set_Abort_Present; - - procedure Set_Abortable_Part - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Asynchronous_Select); - Set_Node2_With_Parent (N, Val); - end Set_Abortable_Part; - - procedure Set_Abstract_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition); - Set_Flag4 (N, Val); - end Set_Abstract_Present; - - procedure Set_Accept_Handler_Records - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative); - Set_List5 (N, Val); -- semantic field, no parent set - end Set_Accept_Handler_Records; - - procedure Set_Accept_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative); - Set_Node2_With_Parent (N, Val); - end Set_Accept_Statement; - - procedure Set_Access_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration); - Set_Node3_With_Parent (N, Val); - end Set_Access_Definition; - - procedure Set_Access_To_Subprogram_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition); - Set_Node3_With_Parent (N, Val); - end Set_Access_To_Subprogram_Definition; - - procedure Set_Access_Types_To_Process - (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Freeze_Entity); - Set_Elist2 (N, Val); -- semantic field, no parent set - end Set_Access_Types_To_Process; - - procedure Set_Actions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_And_Then - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Compilation_Unit_Aux - or else NT (N).Nkind = N_Compound_Statement - or else NT (N).Nkind = N_Expression_With_Actions - or else NT (N).Nkind = N_Freeze_Entity - or else NT (N).Nkind = N_Or_Else); - Set_List1_With_Parent (N, Val); - end Set_Actions; - - procedure Set_Activation_Chain_Entity - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Activation_Chain_Entity; - - procedure Set_Acts_As_Spec - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit - or else NT (N).Nkind = N_Subprogram_Body); - Set_Flag4 (N, Val); - end Set_Acts_As_Spec; - - procedure Set_Actual_Designated_Subtype - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Explicit_Dereference - or else NT (N).Nkind = N_Free_Statement); - Set_Node4 (N, Val); - end Set_Actual_Designated_Subtype; - - procedure Set_Address_Warning_Posted - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause); - Set_Flag18 (N, Val); - end Set_Address_Warning_Posted; - - procedure Set_Aggregate_Bounds - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Aggregate_Bounds; - - procedure Set_Aliased_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - Set_Flag4 (N, Val); - end Set_Aliased_Present; - - procedure Set_Alloc_For_BIP_Return - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - Set_Flag1 (N, Val); - end Set_Alloc_For_BIP_Return; - - procedure Set_All_Others - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Others_Choice); - Set_Flag11 (N, Val); - end Set_All_Others; - - procedure Set_All_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Quantified_Expression - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Flag15 (N, Val); - end Set_All_Present; - - procedure Set_Alternatives - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Expression - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In); - Set_List4_With_Parent (N, Val); - end Set_Alternatives; - - procedure Set_Ancestor_Part - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extension_Aggregate); - Set_Node3_With_Parent (N, Val); - end Set_Ancestor_Part; - - procedure Set_Atomic_Sync_Required - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Explicit_Dereference - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Indexed_Component - or else NT (N).Nkind = N_Selected_Component); - Set_Flag14 (N, Val); - end Set_Atomic_Sync_Required; - - procedure Set_Array_Aggregate - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Enumeration_Representation_Clause); - Set_Node3_With_Parent (N, Val); - end Set_Array_Aggregate; - - procedure Set_Aspect_On_Partial_View - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification); - Set_Flag18 (N, Val); - end Set_Aspect_On_Partial_View; - - procedure Set_Aspect_Rep_Item - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification); - Set_Node2 (N, Val); - end Set_Aspect_Rep_Item; - - procedure Set_Assignment_OK - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind in N_Subexpr); - Set_Flag15 (N, Val); - end Set_Assignment_OK; - - procedure Set_Associated_Node - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Entity - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate - or else NT (N).Nkind = N_Selected_Component - or else NT (N).Nkind = N_Use_Package_Clause); - Set_Node4 (N, Val); -- semantic field, no parent set - end Set_Associated_Node; - - procedure Set_At_End_Proc - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements); - Set_Node1 (N, Val); - end Set_At_End_Proc; - - procedure Set_Attribute_Name - (N : Node_Id; Val : Name_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - Set_Name2 (N, Val); - end Set_Attribute_Name; - - procedure Set_Aux_Decls_Node - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Node5_With_Parent (N, Val); - end Set_Aux_Decls_Node; - - procedure Set_Backwards_OK - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - Set_Flag6 (N, Val); - end Set_Backwards_OK; - - procedure Set_Bad_Is_Detected - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - Set_Flag15 (N, Val); - end Set_Bad_Is_Detected; - - procedure Set_Body_Required - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Flag13 (N, Val); - end Set_Body_Required; - - procedure Set_Body_To_Inline - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Declaration); - Set_Node3 (N, Val); - end Set_Body_To_Inline; - - procedure Set_Box_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Generic_Association - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association); - Set_Flag15 (N, Val); - end Set_Box_Present; - - procedure Set_By_Ref - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - Set_Flag5 (N, Val); - end Set_By_Ref; - - procedure Set_Char_Literal_Value - (N : Node_Id; Val : Uint) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Character_Literal); - Set_Uint2 (N, Val); - end Set_Char_Literal_Value; - - procedure Set_Chars - (N : Node_Id; Val : Name_Id) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Chars); - Set_Name1 (N, Val); - end Set_Chars; - - procedure Set_Check_Address_Alignment - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause); - Set_Flag11 (N, Val); - end Set_Check_Address_Alignment; - - procedure Set_Choice_Parameter - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - Set_Node2_With_Parent (N, Val); - end Set_Choice_Parameter; - - procedure Set_Choices - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association); - Set_List1_With_Parent (N, Val); - end Set_Choices; - - procedure Set_Class_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - Set_Flag6 (N, Val); - end Set_Class_Present; - - procedure Set_Classifications - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Classifications; - - procedure Set_Cleanup_Actions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - Set_List5 (N, Val); -- semantic field, no parent set - end Set_Cleanup_Actions; - - procedure Set_Comes_From_Extended_Return_Statement - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Simple_Return_Statement); - Set_Flag18 (N, Val); - end Set_Comes_From_Extended_Return_Statement; - - procedure Set_Compile_Time_Known_Aggregate - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate); - Set_Flag18 (N, Val); - end Set_Compile_Time_Known_Aggregate; - - procedure Set_Component_Associations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Delta_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - Set_List2_With_Parent (N, Val); - end Set_Component_Associations; - - procedure Set_Component_Clauses - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Record_Representation_Clause); - Set_List3_With_Parent (N, Val); - end Set_Component_Clauses; - - procedure Set_Component_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Constrained_Array_Definition - or else NT (N).Nkind = N_Unconstrained_Array_Definition); - Set_Node4_With_Parent (N, Val); - end Set_Component_Definition; - - procedure Set_Component_Items - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List); - Set_List3_With_Parent (N, Val); - end Set_Component_Items; - - procedure Set_Component_List - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_Variant); - Set_Node1_With_Parent (N, Val); - end Set_Component_List; - - procedure Set_Component_Name - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - Set_Node1_With_Parent (N, Val); - end Set_Component_Name; - - procedure Set_Componentwise_Assignment - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - Set_Flag14 (N, Val); - end Set_Componentwise_Assignment; - - procedure Set_Condition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative - or else NT (N).Nkind = N_Delay_Alternative - or else NT (N).Nkind = N_Elsif_Part - or else NT (N).Nkind = N_Entry_Body_Formal_Part - or else NT (N).Nkind = N_Exit_Statement - or else NT (N).Nkind = N_If_Statement - or else NT (N).Nkind = N_Iteration_Scheme - or else NT (N).Nkind = N_Quantified_Expression - or else NT (N).Nkind = N_Raise_Constraint_Error - or else NT (N).Nkind = N_Raise_Program_Error - or else NT (N).Nkind = N_Raise_Storage_Error - or else NT (N).Nkind = N_Terminate_Alternative); - Set_Node1_With_Parent (N, Val); - end Set_Condition; - - procedure Set_Condition_Actions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Elsif_Part - or else NT (N).Nkind = N_Iteration_Scheme); - Set_List3 (N, Val); -- semantic field, no parent set - end Set_Condition_Actions; - - procedure Set_Config_Pragmas - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit_Aux); - Set_List4_With_Parent (N, Val); - end Set_Config_Pragmas; - - procedure Set_Constant_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Object_Declaration); - Set_Flag17 (N, Val); - end Set_Constant_Present; - - procedure Set_Constraint - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subtype_Indication); - Set_Node3_With_Parent (N, Val); - end Set_Constraint; - - procedure Set_Constraints - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Index_Or_Discriminant_Constraint); - Set_List1_With_Parent (N, Val); - end Set_Constraints; - - procedure Set_Context_Installed - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag13 (N, Val); - end Set_Context_Installed; - - procedure Set_Context_Items - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_List1_With_Parent (N, Val); - end Set_Context_Items; - - procedure Set_Context_Pending - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Flag16 (N, Val); - end Set_Context_Pending; - - procedure Set_Contract_Test_Cases - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Contract_Test_Cases; - - procedure Set_Controlling_Argument - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - Set_Node1 (N, Val); -- semantic field, no parent set - end Set_Controlling_Argument; - - procedure Set_Conversion_OK - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Type_Conversion); - Set_Flag14 (N, Val); - end Set_Conversion_OK; - - procedure Set_Convert_To_Return_False - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Raise_Expression); - Set_Flag13 (N, Val); - end Set_Convert_To_Return_False; - - procedure Set_Corresponding_Aspect - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Node3 (N, Val); - end Set_Corresponding_Aspect; - - procedure Set_Corresponding_Body - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Task_Body_Stub - or else NT (N).Nkind = N_Task_Type_Declaration); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Corresponding_Body; - - procedure Set_Corresponding_Formal_Spec - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Corresponding_Formal_Spec; - - procedure Set_Corresponding_Generic_Association - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Corresponding_Generic_Association; - - procedure Set_Corresponding_Integer_Value - (N : Node_Id; Val : Uint) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Real_Literal); - Set_Uint4 (N, Val); -- semantic field, no parent set - end Set_Corresponding_Integer_Value; - - procedure Set_Corresponding_Spec - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Expression_Function - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration - or else NT (N).Nkind = N_Task_Body - or else NT (N).Nkind = N_With_Clause); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Corresponding_Spec; - - procedure Set_Corresponding_Spec_Of_Stub - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Task_Body_Stub); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Corresponding_Spec_Of_Stub; - - procedure Set_Corresponding_Stub - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subunit); - Set_Node3 (N, Val); - end Set_Corresponding_Stub; - - procedure Set_Dcheck_Function - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Dcheck_Function; - - procedure Set_Declarations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Compilation_Unit_Aux - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - Set_List2_With_Parent (N, Val); - end Set_Declarations; - - procedure Set_Default_Expression - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Default_Expression; - - procedure Set_Default_Storage_Pool - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit_Aux); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Default_Storage_Pool; - - procedure Set_Default_Name - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration); - Set_Node2_With_Parent (N, Val); - end Set_Default_Name; - - procedure Set_Defining_Identifier - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Defining_Program_Unit_Name - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Entry_Index_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Exception_Renaming_Declaration - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Formal_Type_Declaration - or else NT (N).Nkind = N_Full_Type_Declaration - or else NT (N).Nkind = N_Implicit_Label_Declaration - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Single_Protected_Declaration - or else NT (N).Nkind = N_Single_Task_Declaration - or else NT (N).Nkind = N_Subtype_Declaration - or else NT (N).Nkind = N_Task_Body - or else NT (N).Nkind = N_Task_Body_Stub - or else NT (N).Nkind = N_Task_Type_Declaration); - Set_Node1_With_Parent (N, Val); - end Set_Defining_Identifier; - - procedure Set_Defining_Unit_Name - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Generic_Function_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Package_Renaming_Declaration - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Procedure_Specification); - Set_Node1_With_Parent (N, Val); - end Set_Defining_Unit_Name; - - procedure Set_Delay_Alternative - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Timed_Entry_Call); - Set_Node4_With_Parent (N, Val); - end Set_Delay_Alternative; - - procedure Set_Delay_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Delay_Alternative); - Set_Node2_With_Parent (N, Val); - end Set_Delay_Statement; - - procedure Set_Delta_Expression - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Decimal_Fixed_Point_Definition - or else NT (N).Nkind = N_Delta_Constraint - or else NT (N).Nkind = N_Ordinary_Fixed_Point_Definition); - Set_Node3_With_Parent (N, Val); - end Set_Delta_Expression; - - procedure Set_Digits_Expression - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Decimal_Fixed_Point_Definition - or else NT (N).Nkind = N_Digits_Constraint - or else NT (N).Nkind = N_Floating_Point_Definition); - Set_Node2_With_Parent (N, Val); - end Set_Digits_Expression; - - procedure Set_Discr_Check_Funcs_Built - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Full_Type_Declaration); - Set_Flag11 (N, Val); - end Set_Discr_Check_Funcs_Built; - - procedure Set_Discrete_Choices - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Case_Statement_Alternative - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Variant); - Set_List4_With_Parent (N, Val); - end Set_Discrete_Choices; - - procedure Set_Discrete_Range - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Slice); - Set_Node4_With_Parent (N, Val); - end Set_Discrete_Range; - - procedure Set_Discrete_Subtype_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Entry_Index_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification); - Set_Node4_With_Parent (N, Val); - end Set_Discrete_Subtype_Definition; - - procedure Set_Discrete_Subtype_Definitions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Constrained_Array_Definition); - Set_List2_With_Parent (N, Val); - end Set_Discrete_Subtype_Definitions; - - procedure Set_Discriminant_Specifications - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Type_Declaration - or else NT (N).Nkind = N_Full_Type_Declaration - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Task_Type_Declaration); - Set_List4_With_Parent (N, Val); - end Set_Discriminant_Specifications; - - procedure Set_Discriminant_Type - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Discriminant_Specification); - Set_Node5_With_Parent (N, Val); - end Set_Discriminant_Type; - - procedure Set_Do_Accessibility_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Specification); - Set_Flag13 (N, Val); - end Set_Do_Accessibility_Check; - - procedure Set_Do_Discriminant_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Selected_Component - or else NT (N).Nkind = N_Type_Conversion); - Set_Flag3 (N, Val); - end Set_Do_Discriminant_Check; - - procedure Set_Do_Division_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Divide - or else NT (N).Nkind = N_Op_Mod - or else NT (N).Nkind = N_Op_Rem); - Set_Flag13 (N, Val); - end Set_Do_Division_Check; - - procedure Set_Do_Length_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Op_And - or else NT (N).Nkind = N_Op_Or - or else NT (N).Nkind = N_Op_Xor - or else NT (N).Nkind = N_Type_Conversion); - Set_Flag4 (N, Val); - end Set_Do_Length_Check; - - procedure Set_Do_Overflow_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Op - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Case_Expression - or else NT (N).Nkind = N_If_Expression - or else NT (N).Nkind = N_Type_Conversion); - Set_Flag17 (N, Val); - end Set_Do_Overflow_Check; - - procedure Set_Do_Range_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - Set_Flag9 (N, Val); - end Set_Do_Range_Check; - - procedure Set_Do_Storage_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Subprogram_Body); - Set_Flag17 (N, Val); - end Set_Do_Storage_Check; - - procedure Set_Do_Tag_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Simple_Return_Statement - or else NT (N).Nkind = N_Type_Conversion); - Set_Flag13 (N, Val); - end Set_Do_Tag_Check; - - procedure Set_Elaborate_All_Desirable - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag9 (N, Val); - end Set_Elaborate_All_Desirable; - - procedure Set_Elaborate_All_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag14 (N, Val); - end Set_Elaborate_All_Present; - - procedure Set_Elaborate_Desirable - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag11 (N, Val); - end Set_Elaborate_Desirable; - - procedure Set_Elaborate_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag4 (N, Val); - end Set_Elaborate_Present; - - procedure Set_Else_Actions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Expression); - Set_List3_With_Parent (N, Val); -- semantic field, but needs parents - end Set_Else_Actions; - - procedure Set_Else_Statements - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Conditional_Entry_Call - or else NT (N).Nkind = N_If_Statement - or else NT (N).Nkind = N_Selective_Accept); - Set_List4_With_Parent (N, Val); - end Set_Else_Statements; - - procedure Set_Elsif_Parts - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Statement); - Set_List3_With_Parent (N, Val); - end Set_Elsif_Parts; - - procedure Set_Enclosing_Variant - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Enclosing_Variant; - - procedure Set_End_Label - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Enumeration_Type_Definition - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements - or else NT (N).Nkind = N_Loop_Statement - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Protected_Definition - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_Task_Definition); - Set_Node4_With_Parent (N, Val); - end Set_End_Label; - - procedure Set_End_Span - (N : Node_Id; Val : Uint) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_If_Statement); - Set_Uint5 (N, Val); - end Set_End_Span; - - procedure Set_Entity - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Entity - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Freeze_Entity - or else NT (N).Nkind = N_Freeze_Generic_Entity); - Set_Node4 (N, Val); -- semantic field, no parent set - end Set_Entity; - - procedure Set_Entry_Body_Formal_Part - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Body); - Set_Node5_With_Parent (N, Val); - end Set_Entry_Body_Formal_Part; - - procedure Set_Entry_Call_Alternative - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Conditional_Entry_Call - or else NT (N).Nkind = N_Timed_Entry_Call); - Set_Node1_With_Parent (N, Val); - end Set_Entry_Call_Alternative; - - procedure Set_Entry_Call_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Call_Alternative); - Set_Node1_With_Parent (N, Val); - end Set_Entry_Call_Statement; - - procedure Set_Entry_Direct_Name - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement); - Set_Node1_With_Parent (N, Val); - end Set_Entry_Direct_Name; - - procedure Set_Entry_Index - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement); - Set_Node5_With_Parent (N, Val); - end Set_Entry_Index; - - procedure Set_Entry_Index_Specification - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Body_Formal_Part); - Set_Node4_With_Parent (N, Val); - end Set_Entry_Index_Specification; - - procedure Set_Etype - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Has_Etype); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Etype; - - procedure Set_Exception_Choices - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - Set_List4_With_Parent (N, Val); - end Set_Exception_Choices; - - procedure Set_Exception_Handlers - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements); - Set_List5_With_Parent (N, Val); - end Set_Exception_Handlers; - - procedure Set_Exception_Junk - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Goto_Statement - or else NT (N).Nkind = N_Label - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Subtype_Declaration); - Set_Flag8 (N, Val); - end Set_Exception_Junk; - - procedure Set_Exception_Label - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler - or else NT (N).Nkind = N_Push_Constraint_Error_Label - or else NT (N).Nkind = N_Push_Program_Error_Label - or else NT (N).Nkind = N_Push_Storage_Error_Label); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Exception_Label; - - procedure Set_Expansion_Delayed - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - Set_Flag11 (N, Val); - end Set_Expansion_Delayed; - - procedure Set_Explicit_Actual_Parameter - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Association); - Set_Node3_With_Parent (N, Val); - end Set_Explicit_Actual_Parameter; - - procedure Set_Explicit_Generic_Actual_Parameter - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Generic_Association); - Set_Node1_With_Parent (N, Val); - end Set_Explicit_Generic_Actual_Parameter; - - procedure Set_Expression - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_At_Clause - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Case_Expression - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_Code_Statement - or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Delay_Relative_Statement - or else NT (N).Nkind = N_Delay_Until_Statement - or else NT (N).Nkind = N_Delta_Aggregate - or else NT (N).Nkind = N_Discriminant_Association - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Expression_Function - or else NT (N).Nkind = N_Expression_With_Actions - or else NT (N).Nkind = N_Free_Statement - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association - or else NT (N).Nkind = N_Mod_Clause - or else NT (N).Nkind = N_Modular_Type_Definition - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Pragma_Argument_Association - or else NT (N).Nkind = N_Qualified_Expression - or else NT (N).Nkind = N_Raise_Expression - or else NT (N).Nkind = N_Raise_Statement - or else NT (N).Nkind = N_Simple_Return_Statement - or else NT (N).Nkind = N_Type_Conversion - or else NT (N).Nkind = N_Unchecked_Expression - or else NT (N).Nkind = N_Unchecked_Type_Conversion); - Set_Node3_With_Parent (N, Val); - end Set_Expression; - - procedure Set_Expression_Copy - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma_Argument_Association); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Expression_Copy; - - procedure Set_Expressions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Extension_Aggregate - or else NT (N).Nkind = N_If_Expression - or else NT (N).Nkind = N_Indexed_Component); - Set_List1_With_Parent (N, Val); - end Set_Expressions; - - procedure Set_First_Bit - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - Set_Node3_With_Parent (N, Val); - end Set_First_Bit; - - procedure Set_First_Inlined_Subprogram - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_First_Inlined_Subprogram; - - procedure Set_First_Name - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag5 (N, Val); - end Set_First_Name; - - procedure Set_First_Named_Actual - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - Set_Node4 (N, Val); -- semantic field, no parent set - end Set_First_Named_Actual; - - procedure Set_First_Real_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_First_Real_Statement; - - procedure Set_First_Subtype_Link - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Freeze_Entity); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_First_Subtype_Link; - - procedure Set_Float_Truncate - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Type_Conversion); - Set_Flag11 (N, Val); - end Set_Float_Truncate; - - procedure Set_Formal_Type_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Type_Declaration); - Set_Node3_With_Parent (N, Val); - end Set_Formal_Type_Definition; - - procedure Set_Forwards_OK - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - Set_Flag5 (N, Val); - end Set_Forwards_OK; - - procedure Set_From_Aspect_Specification - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Pragma); - Set_Flag13 (N, Val); - end Set_From_Aspect_Specification; - - procedure Set_From_At_End - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Raise_Statement); - Set_Flag4 (N, Val); - end Set_From_At_End; - - procedure Set_From_At_Mod - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Definition_Clause); - Set_Flag4 (N, Val); - end Set_From_At_Mod; - - procedure Set_From_Conditional_Expression - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Statement - or else NT (N).Nkind = N_If_Statement); - Set_Flag1 (N, Val); - end Set_From_Conditional_Expression; - - procedure Set_From_Default - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - Set_Flag6 (N, Val); - end Set_From_Default; - - procedure Set_Generalized_Indexing - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Indexed_Component); - Set_Node4 (N, Val); - end Set_Generalized_Indexing; - - procedure Set_Generic_Associations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - Set_List3_With_Parent (N, Val); - end Set_Generic_Associations; - - procedure Set_Generic_Formal_Declarations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration); - Set_List2_With_Parent (N, Val); - end Set_Generic_Formal_Declarations; - - procedure Set_Generic_Parent - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Procedure_Specification); - Set_Node5 (N, Val); - end Set_Generic_Parent; - - procedure Set_Generic_Parent_Type - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subtype_Declaration); - Set_Node4 (N, Val); - end Set_Generic_Parent_Type; - - procedure Set_Handled_Statement_Sequence - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Entry_Body - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - Set_Node4_With_Parent (N, Val); - end Set_Handled_Statement_Sequence; - - procedure Set_Handler_List_Entry - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - Set_Node2 (N, Val); - end Set_Handler_List_Entry; - - procedure Set_Has_Created_Identifier - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Loop_Statement); - Set_Flag15 (N, Val); - end Set_Has_Created_Identifier; - - procedure Set_Has_Dereference_Action - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Explicit_Dereference); - Set_Flag13 (N, Val); - end Set_Has_Dereference_Action; - - procedure Set_Has_Dynamic_Length_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - Set_Flag10 (N, Val); - end Set_Has_Dynamic_Length_Check; - - procedure Set_Has_Init_Expression - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - Set_Flag14 (N, Val); - end Set_Has_Init_Expression; - - procedure Set_Has_Local_Raise - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - Set_Flag8 (N, Val); - end Set_Has_Local_Raise; - - procedure Set_Has_No_Elaboration_Code - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Flag17 (N, Val); - end Set_Has_No_Elaboration_Code; - - procedure Set_Has_Pragma_Suppress_All - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Flag14 (N, Val); - end Set_Has_Pragma_Suppress_All; - - procedure Set_Has_Private_View - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Op - or else NT (N).Nkind = N_Character_Literal - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Operator_Symbol); - Set_Flag11 (N, Val); - end Set_Has_Private_View; - - procedure Set_Has_Relative_Deadline_Pragma - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Definition); - Set_Flag9 (N, Val); - end Set_Has_Relative_Deadline_Pragma; - - procedure Set_Has_Self_Reference - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - Set_Flag13 (N, Val); - end Set_Has_Self_Reference; - - procedure Set_Has_SP_Choice - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Case_Expression_Alternative - or else NT (N).Nkind = N_Case_Statement_Alternative - or else NT (N).Nkind = N_Variant); - Set_Flag15 (N, Val); - end Set_Has_SP_Choice; - - procedure Set_Has_Storage_Size_Pragma - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Task_Definition); - Set_Flag5 (N, Val); - end Set_Has_Storage_Size_Pragma; - - procedure Set_Has_Target_Names - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - Set_Flag8 (N, Val); - end Set_Has_Target_Names; - - procedure Set_Has_Wide_Character - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_String_Literal); - Set_Flag11 (N, Val); - end Set_Has_Wide_Character; - - procedure Set_Has_Wide_Wide_Character - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_String_Literal); - Set_Flag13 (N, Val); - end Set_Has_Wide_Wide_Character; - - procedure Set_Header_Size_Added - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - Set_Flag11 (N, Val); - end Set_Header_Size_Added; - - procedure Set_Hidden_By_Use_Clause - (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Elist5 (N, Val); - end Set_Hidden_By_Use_Clause; - - procedure Set_High_Bound - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range - or else NT (N).Nkind = N_Real_Range_Specification - or else NT (N).Nkind = N_Signed_Integer_Type_Definition); - Set_Node2_With_Parent (N, Val); - end Set_High_Bound; - - procedure Set_Identifier - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_At_Clause - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Designator - or else NT (N).Nkind = N_Enumeration_Representation_Clause - or else NT (N).Nkind = N_Label - or else NT (N).Nkind = N_Loop_Statement - or else NT (N).Nkind = N_Record_Representation_Clause); - Set_Node1_With_Parent (N, Val); - end Set_Identifier; - - procedure Set_Implicit_With - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag16 (N, Val); - end Set_Implicit_With; - - procedure Set_Interface_List - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_Single_Protected_Declaration - or else NT (N).Nkind = N_Single_Task_Declaration - or else NT (N).Nkind = N_Task_Type_Declaration); - Set_List2_With_Parent (N, Val); - end Set_Interface_List; - - procedure Set_Interface_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Record_Definition); - Set_Flag16 (N, Val); - end Set_Interface_Present; - - procedure Set_Import_Interface_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag16 (N, Val); - end Set_Import_Interface_Present; - - procedure Set_In_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - Set_Flag15 (N, Val); - end Set_In_Present; - - procedure Set_Includes_Infinities - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range); - Set_Flag11 (N, Val); - end Set_Includes_Infinities; - - procedure Set_Incomplete_View - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Full_Type_Declaration); - Set_Node2 (N, Val); -- semantic field, no Parent set - end Set_Incomplete_View; - - procedure Set_Inherited_Discriminant - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association); - Set_Flag13 (N, Val); - end Set_Inherited_Discriminant; - - procedure Set_Instance_Spec - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - Set_Node5 (N, Val); -- semantic field, no Parent set - end Set_Instance_Spec; - - procedure Set_Intval - (N : Node_Id; Val : Uint) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Integer_Literal); - Set_Uint3 (N, Val); - end Set_Intval; - - procedure Set_Is_Abort_Block - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - Set_Flag4 (N, Val); - end Set_Is_Abort_Block; - - procedure Set_Is_Accessibility_Actual - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Association); - Set_Flag13 (N, Val); - end Set_Is_Accessibility_Actual; - - procedure Set_Is_Analyzed_Pragma - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag5 (N, Val); - end Set_Is_Analyzed_Pragma; - - procedure Set_Is_Asynchronous_Call_Block - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - Set_Flag7 (N, Val); - end Set_Is_Asynchronous_Call_Block; - - procedure Set_Is_Boolean_Aspect - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification); - Set_Flag16 (N, Val); - end Set_Is_Boolean_Aspect; - - procedure Set_Is_Checked - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - Set_Flag11 (N, Val); - end Set_Is_Checked; - - procedure Set_Is_Checked_Ghost_Pragma - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag3 (N, Val); - end Set_Is_Checked_Ghost_Pragma; - - procedure Set_Is_Component_Left_Opnd - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Concat); - Set_Flag13 (N, Val); - end Set_Is_Component_Left_Opnd; - - procedure Set_Is_Component_Right_Opnd - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Concat); - Set_Flag14 (N, Val); - end Set_Is_Component_Right_Opnd; - - procedure Set_Is_Controlling_Actual - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - Set_Flag16 (N, Val); - end Set_Is_Controlling_Actual; - - procedure Set_Is_Declaration_Level_Node - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Instantiation); - Set_Flag5 (N, Val); - end Set_Is_Declaration_Level_Node; - - procedure Set_Is_Delayed_Aspect - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Pragma); - Set_Flag14 (N, Val); - end Set_Is_Delayed_Aspect; - - procedure Set_Is_Disabled - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - Set_Flag15 (N, Val); - end Set_Is_Disabled; - - procedure Set_Is_Dispatching_Call - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); - Set_Flag6 (N, Val); - end Set_Is_Dispatching_Call; - - procedure Set_Is_Dynamic_Coextension - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - pragma Assert (not Val - or else not Is_Static_Coextension (N)); - Set_Flag18 (N, Val); - end Set_Is_Dynamic_Coextension; - - procedure Set_Is_Effective_Use_Clause - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Flag1 (N, Val); - end Set_Is_Effective_Use_Clause; - - procedure Set_Is_Elaboration_Checks_OK_Node - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Variable_Reference_Marker); - Set_Flag1 (N, Val); - end Set_Is_Elaboration_Checks_OK_Node; - - procedure Set_Is_Elaboration_Code - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - Set_Flag9 (N, Val); - end Set_Is_Elaboration_Code; - - procedure Set_Is_Elaboration_Warnings_OK_Node - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Variable_Reference_Marker); - Set_Flag3 (N, Val); - end Set_Is_Elaboration_Warnings_OK_Node; - - procedure Set_Is_Elsif - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Expression); - Set_Flag13 (N, Val); - end Set_Is_Elsif; - - procedure Set_Is_Entry_Barrier_Function - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Declaration); - Set_Flag8 (N, Val); - end Set_Is_Entry_Barrier_Function; - - procedure Set_Is_Expanded_Build_In_Place_Call - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call); - Set_Flag11 (N, Val); - end Set_Is_Expanded_Build_In_Place_Call; - - procedure Set_Is_Expanded_Contract - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - Set_Flag1 (N, Val); - end Set_Is_Expanded_Contract; - - procedure Set_Is_Finalization_Wrapper - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - Set_Flag9 (N, Val); - end Set_Is_Finalization_Wrapper; - - procedure Set_Is_Folded_In_Parser - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_String_Literal); - Set_Flag4 (N, Val); - end Set_Is_Folded_In_Parser; - - procedure Set_Is_Generic_Contract_Pragma - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag2 (N, Val); - end Set_Is_Generic_Contract_Pragma; - - procedure Set_Is_Homogeneous_Aggregate - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate); - Set_Flag14 (N, Val); - end Set_Is_Homogeneous_Aggregate; - - procedure Set_Is_Ignored - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - Set_Flag9 (N, Val); - end Set_Is_Ignored; - - procedure Set_Is_Ignored_Ghost_Pragma - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag8 (N, Val); - end Set_Is_Ignored_Ghost_Pragma; - - procedure Set_Is_In_Discriminant_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Selected_Component); - Set_Flag11 (N, Val); - end Set_Is_In_Discriminant_Check; - - procedure Set_Is_Inherited_Pragma - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag4 (N, Val); - end Set_Is_Inherited_Pragma; - - procedure Set_Is_Initialization_Block - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - Set_Flag1 (N, Val); - end Set_Is_Initialization_Block; - - procedure Set_Is_Known_Guaranteed_ABE - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation); - Set_Flag18 (N, Val); - end Set_Is_Known_Guaranteed_ABE; - - procedure Set_Is_Machine_Number - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Real_Literal); - Set_Flag11 (N, Val); - end Set_Is_Machine_Number; - - procedure Set_Is_Null_Loop - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Loop_Statement); - Set_Flag16 (N, Val); - end Set_Is_Null_Loop; - - procedure Set_Is_Overloaded - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - Set_Flag5 (N, Val); - end Set_Is_Overloaded; - - procedure Set_Is_Power_Of_2_For_Shift - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Expon); - Set_Flag13 (N, Val); - end Set_Is_Power_Of_2_For_Shift; - - procedure Set_Is_Preelaborable_Call - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); - Set_Flag7 (N, Val); - end Set_Is_Preelaborable_Call; - - procedure Set_Is_Prefixed_Call - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Selected_Component); - Set_Flag17 (N, Val); - end Set_Is_Prefixed_Call; - - procedure Set_Is_Protected_Subprogram_Body - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - Set_Flag7 (N, Val); - end Set_Is_Protected_Subprogram_Body; - - procedure Set_Is_Qualified_Universal_Literal - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Qualified_Expression); - Set_Flag4 (N, Val); - end Set_Is_Qualified_Universal_Literal; - - procedure Set_Is_Read - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variable_Reference_Marker); - Set_Flag4 (N, Val); - end Set_Is_Read; - - procedure Set_Is_Source_Call - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker); - Set_Flag4 (N, Val); - end Set_Is_Source_Call; - - procedure Set_Is_SPARK_Mode_On_Node - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Identifier - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Variable_Reference_Marker); - Set_Flag2 (N, Val); - end Set_Is_SPARK_Mode_On_Node; - - procedure Set_Is_Static_Coextension - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - pragma Assert (not Val - or else not Is_Dynamic_Coextension (N)); - Set_Flag14 (N, Val); - end Set_Is_Static_Coextension; - - procedure Set_Is_Static_Expression - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - Set_Flag6 (N, Val); - end Set_Is_Static_Expression; - - procedure Set_Is_Subprogram_Descriptor - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - Set_Flag16 (N, Val); - end Set_Is_Subprogram_Descriptor; - - procedure Set_Is_Task_Allocation_Block - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement); - Set_Flag6 (N, Val); - end Set_Is_Task_Allocation_Block; - - procedure Set_Is_Task_Body_Procedure - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Declaration); - Set_Flag1 (N, Val); - end Set_Is_Task_Body_Procedure; - - procedure Set_Is_Task_Master - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Block_Statement - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - Set_Flag5 (N, Val); - end Set_Is_Task_Master; - - procedure Set_Is_Write - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variable_Reference_Marker); - Set_Flag5 (N, Val); - end Set_Is_Write; - - procedure Set_Iterator_Filter - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification); - Set_Node3_With_Parent (N, Val); - end Set_Iterator_Filter; - - procedure Set_Iteration_Scheme - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Loop_Statement); - Set_Node2_With_Parent (N, Val); - end Set_Iteration_Scheme; - - procedure Set_Iterator_Specification - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association - or else NT (N).Nkind = N_Iteration_Scheme - or else NT (N).Nkind = N_Quantified_Expression); - Set_Node2_With_Parent (N, Val); - end Set_Iterator_Specification; - - procedure Set_Itype - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Itype_Reference); - Set_Node1 (N, Val); -- no parent, semantic field - end Set_Itype; - - procedure Set_Key_Expression - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterated_Element_Association); - Set_Node1_With_Parent (N, Val); - end Set_Key_Expression; - - procedure Set_Kill_Range_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Unchecked_Type_Conversion); - Set_Flag11 (N, Val); - end Set_Kill_Range_Check; - - procedure Set_Label_Construct - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Implicit_Label_Declaration); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Label_Construct; - - procedure Set_Last_Bit - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - Set_Node4_With_Parent (N, Val); - end Set_Last_Bit; - - procedure Set_Last_Name - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag6 (N, Val); - end Set_Last_Name; - - procedure Set_Left_Opnd - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_And_Then - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In - or else NT (N).Nkind = N_Or_Else - or else NT (N).Nkind in N_Binary_Op); - Set_Node2_With_Parent (N, Val); - end Set_Left_Opnd; - - procedure Set_Library_Unit - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit - or else NT (N).Nkind = N_Package_Body_Stub - or else NT (N).Nkind = N_Protected_Body_Stub - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Task_Body_Stub - or else NT (N).Nkind = N_With_Clause); - Set_Node4 (N, Val); -- semantic field, no parent set - end Set_Library_Unit; - - procedure Set_Limited_View_Installed - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_With_Clause); - Set_Flag18 (N, Val); - end Set_Limited_View_Installed; - - procedure Set_Limited_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_With_Clause); - Set_Flag17 (N, Val); - end Set_Limited_Present; - - procedure Set_Literals - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Enumeration_Type_Definition); - Set_List1_With_Parent (N, Val); - end Set_Literals; - - procedure Set_Local_Raise_Not_OK - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - Set_Flag7 (N, Val); - end Set_Local_Raise_Not_OK; - - procedure Set_Local_Raise_Statements - (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Handler); - Set_Elist1 (N, Val); - end Set_Local_Raise_Statements; - - procedure Set_Loop_Actions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association - or else NT (N).Nkind = N_Iterated_Component_Association - or else NT (N).Nkind = N_Iterated_Element_Association); - Set_List5 (N, Val); -- semantic field, no parent set - end Set_Loop_Actions; - - procedure Set_Loop_Parameter_Specification - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterated_Element_Association - or else NT (N).Nkind = N_Iteration_Scheme - or else NT (N).Nkind = N_Quantified_Expression); - Set_Node4_With_Parent (N, Val); - end Set_Loop_Parameter_Specification; - - procedure Set_Low_Bound - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range - or else NT (N).Nkind = N_Real_Range_Specification - or else NT (N).Nkind = N_Signed_Integer_Type_Definition); - Set_Node1_With_Parent (N, Val); - end Set_Low_Bound; - - procedure Set_Mod_Clause - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Record_Representation_Clause); - Set_Node2_With_Parent (N, Val); - end Set_Mod_Clause; - - procedure Set_More_Ids - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Flag5 (N, Val); - end Set_More_Ids; - - procedure Set_Must_Be_Byte_Aligned - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference); - Set_Flag14 (N, Val); - end Set_Must_Be_Byte_Aligned; - - procedure Set_Must_Not_Freeze - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subtype_Indication - or else NT (N).Nkind in N_Subexpr); - Set_Flag8 (N, Val); - end Set_Must_Not_Freeze; - - procedure Set_Must_Not_Override - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Procedure_Specification); - Set_Flag15 (N, Val); - end Set_Must_Not_Override; - - procedure Set_Must_Override - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Procedure_Specification); - Set_Flag14 (N, Val); - end Set_Must_Override; - - procedure Set_Name - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Defining_Program_Unit_Name - or else NT (N).Nkind = N_Designator - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Exception_Renaming_Declaration - or else NT (N).Nkind = N_Exit_Statement - or else NT (N).Nkind = N_Formal_Package_Declaration - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Generic_Function_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration - or else NT (N).Nkind = N_Goto_Statement - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Package_Renaming_Declaration - or else NT (N).Nkind = N_Procedure_Call_Statement - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Raise_Expression - or else NT (N).Nkind = N_Raise_Statement - or else NT (N).Nkind = N_Requeue_Statement - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration - or else NT (N).Nkind = N_Subunit - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Variant_Part - or else NT (N).Nkind = N_With_Clause); - Set_Node2_With_Parent (N, Val); - end Set_Name; - - procedure Set_Names - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Abort_Statement); - Set_List2_With_Parent (N, Val); - end Set_Names; - - procedure Set_Next_Entity - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Defining_Character_Literal - or else NT (N).Nkind = N_Defining_Identifier - or else NT (N).Nkind = N_Defining_Operator_Symbol); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Next_Entity; - - procedure Set_Next_Exit_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exit_Statement); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Next_Exit_Statement; - - procedure Set_Next_Implicit_With - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Next_Implicit_With; - - procedure Set_Next_Named_Actual - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Association); - Set_Node4 (N, Val); -- semantic field, no parent set - end Set_Next_Named_Actual; - - procedure Set_Next_Pragma - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Node1 (N, Val); -- semantic field, no parent set - end Set_Next_Pragma; - - procedure Set_Next_Rep_Item - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Attribute_Definition_Clause - or else NT (N).Nkind = N_Enumeration_Representation_Clause - or else NT (N).Nkind = N_Null_Statement - or else NT (N).Nkind = N_Pragma - or else NT (N).Nkind = N_Record_Representation_Clause); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Next_Rep_Item; - - procedure Set_Next_Use_Clause - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Next_Use_Clause; - - procedure Set_No_Ctrl_Actions - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement); - Set_Flag7 (N, Val); - end Set_No_Ctrl_Actions; - - procedure Set_No_Elaboration_Check - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - Set_Flag4 (N, Val); - end Set_No_Elaboration_Check; - - procedure Set_No_Entities_Ref_In_Spec - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag8 (N, Val); - end Set_No_Entities_Ref_In_Spec; - - procedure Set_No_Initialization - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Object_Declaration); - Set_Flag13 (N, Val); - end Set_No_Initialization; - - procedure Set_No_Minimize_Eliminate - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In); - Set_Flag17 (N, Val); - end Set_No_Minimize_Eliminate; - - procedure Set_No_Side_Effect_Removal - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Call); - Set_Flag17 (N, Val); - end Set_No_Side_Effect_Removal; - - procedure Set_No_Truncation - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Unchecked_Type_Conversion); - Set_Flag17 (N, Val); - end Set_No_Truncation; - - procedure Set_Null_Excluding_Subtype - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_To_Object_Definition); - Set_Flag16 (N, Val); - end Set_Null_Excluding_Subtype; - - procedure Set_Null_Exclusion_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Subtype_Declaration); - Set_Flag11 (N, Val); - end Set_Null_Exclusion_Present; - - procedure Set_Null_Exclusion_In_Return_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Function_Definition); - Set_Flag14 (N, Val); - end Set_Null_Exclusion_In_Return_Present; - - procedure Set_Null_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List - or else NT (N).Nkind = N_Procedure_Specification - or else NT (N).Nkind = N_Record_Definition); - Set_Flag13 (N, Val); - end Set_Null_Present; - - procedure Set_Null_Record_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aggregate - or else NT (N).Nkind = N_Extension_Aggregate); - Set_Flag17 (N, Val); - end Set_Null_Record_Present; - - procedure Set_Null_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Procedure_Specification); - Set_Node2 (N, Val); - end Set_Null_Statement; - - procedure Set_Object_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - Set_Node4_With_Parent (N, Val); - end Set_Object_Definition; - - procedure Set_Of_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterator_Specification); - Set_Flag16 (N, Val); - end Set_Of_Present; - - procedure Set_Original_Discriminant - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Identifier); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Original_Discriminant; - - procedure Set_Original_Entity - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Integer_Literal - or else NT (N).Nkind = N_Real_Literal); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Original_Entity; - - procedure Set_Others_Discrete_Choices - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Others_Choice); - Set_List1_With_Parent (N, Val); - end Set_Others_Discrete_Choices; - - procedure Set_Out_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification); - Set_Flag17 (N, Val); - end Set_Out_Present; - - procedure Set_Parameter_Associations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Entry_Call_Statement - or else NT (N).Nkind = N_Function_Call - or else NT (N).Nkind = N_Procedure_Call_Statement); - Set_List3_With_Parent (N, Val); - end Set_Parameter_Associations; - - procedure Set_Parameter_Specifications - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Statement - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition - or else NT (N).Nkind = N_Entry_Body_Formal_Part - or else NT (N).Nkind = N_Entry_Declaration - or else NT (N).Nkind = N_Function_Specification - or else NT (N).Nkind = N_Procedure_Specification); - Set_List3_With_Parent (N, Val); - end Set_Parameter_Specifications; - - procedure Set_Parameter_Type - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Parameter_Specification); - Set_Node2_With_Parent (N, Val); - end Set_Parameter_Type; - - procedure Set_Parent_Spec - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Function_Instantiation - or else NT (N).Nkind = N_Generic_Function_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Package_Instantiation - or else NT (N).Nkind = N_Package_Renaming_Declaration - or else NT (N).Nkind = N_Procedure_Instantiation - or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - Set_Node4 (N, Val); -- semantic field, no parent set - end Set_Parent_Spec; - - procedure Set_Parent_With - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag1 (N, Val); - end Set_Parent_With; - - procedure Set_Position - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Clause); - Set_Node2_With_Parent (N, Val); - end Set_Position; - - procedure Set_Pragma_Argument_Associations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_List2_With_Parent (N, Val); - end Set_Pragma_Argument_Associations; - - procedure Set_Pragma_Identifier - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Node4_With_Parent (N, Val); - end Set_Pragma_Identifier; - - procedure Set_Pragmas_After - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit_Aux - or else NT (N).Nkind = N_Terminate_Alternative); - Set_List5_With_Parent (N, Val); - end Set_Pragmas_After; - - procedure Set_Pragmas_Before - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Accept_Alternative - or else NT (N).Nkind = N_Delay_Alternative - or else NT (N).Nkind = N_Entry_Call_Alternative - or else NT (N).Nkind = N_Mod_Clause - or else NT (N).Nkind = N_Terminate_Alternative - or else NT (N).Nkind = N_Triggering_Alternative); - Set_List4_With_Parent (N, Val); - end Set_Pragmas_Before; - - procedure Set_Pre_Post_Conditions - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Contract); - Set_Node1 (N, Val); -- semantic field, no parent set - end Set_Pre_Post_Conditions; - - procedure Set_Prefix - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Explicit_Dereference - or else NT (N).Nkind = N_Indexed_Component - or else NT (N).Nkind = N_Reference - or else NT (N).Nkind = N_Selected_Component - or else NT (N).Nkind = N_Slice); - Set_Node3_With_Parent (N, Val); - end Set_Prefix; - - procedure Set_Premature_Use - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Incomplete_Type_Declaration); - Set_Node5 (N, Val); - end Set_Premature_Use; - - procedure Set_Present_Expr - (N : Node_Id; Val : Uint) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant); - Set_Uint3 (N, Val); - end Set_Present_Expr; - - procedure Set_Prev_Ids - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Discriminant_Specification - or else NT (N).Nkind = N_Exception_Declaration - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Number_Declaration - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Parameter_Specification - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Flag6 (N, Val); - end Set_Prev_Ids; - - procedure Set_Prev_Use_Clause - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Package_Clause - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Node1 (N, Val); -- semantic field, no parent set - end Set_Prev_Use_Clause; - - procedure Set_Print_In_Hex - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Integer_Literal); - Set_Flag13 (N, Val); - end Set_Print_In_Hex; - - procedure Set_Private_Declarations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Protected_Definition - or else NT (N).Nkind = N_Task_Definition); - Set_List3_With_Parent (N, Val); - end Set_Private_Declarations; - - procedure Set_Private_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_With_Clause); - Set_Flag15 (N, Val); - end Set_Private_Present; - - procedure Set_Procedure_To_Call - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Free_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Procedure_To_Call; - - procedure Set_Proper_Body - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subunit); - Set_Node1_With_Parent (N, Val); - end Set_Proper_Body; - - procedure Set_Protected_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Protected_Type_Declaration - or else NT (N).Nkind = N_Single_Protected_Declaration); - Set_Node3_With_Parent (N, Val); - end Set_Protected_Definition; - - procedure Set_Protected_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Access_Procedure_Definition - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Record_Definition); - Set_Flag6 (N, Val); - end Set_Protected_Present; - - procedure Set_Raises_Constraint_Error - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Subexpr); - Set_Flag7 (N, Val); - end Set_Raises_Constraint_Error; - - procedure Set_Range_Constraint - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Delta_Constraint - or else NT (N).Nkind = N_Digits_Constraint); - Set_Node4_With_Parent (N, Val); - end Set_Range_Constraint; - - procedure Set_Range_Expression - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Range_Constraint); - Set_Node4_With_Parent (N, Val); - end Set_Range_Expression; - - procedure Set_Real_Range_Specification - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Decimal_Fixed_Point_Definition - or else NT (N).Nkind = N_Floating_Point_Definition - or else NT (N).Nkind = N_Ordinary_Fixed_Point_Definition); - Set_Node4_With_Parent (N, Val); - end Set_Real_Range_Specification; - - procedure Set_Realval - (N : Node_Id; Val : Ureal) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Real_Literal); - Set_Ureal3 (N, Val); - end Set_Realval; - - procedure Set_Reason - (N : Node_Id; Val : Uint) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Raise_Constraint_Error - or else NT (N).Nkind = N_Raise_Program_Error - or else NT (N).Nkind = N_Raise_Storage_Error); - Set_Uint3 (N, Val); - end Set_Reason; - - procedure Set_Record_Extension_Part - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition); - Set_Node3_With_Parent (N, Val); - end Set_Record_Extension_Part; - - procedure Set_Redundant_Use - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Attribute_Reference - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Identifier); - Set_Flag13 (N, Val); - end Set_Redundant_Use; - - procedure Set_Renaming_Exception - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Exception_Declaration); - Set_Node2 (N, Val); - end Set_Renaming_Exception; - - procedure Set_Result_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Function_Definition - or else NT (N).Nkind = N_Function_Specification); - Set_Node4_With_Parent (N, Val); - end Set_Result_Definition; - - procedure Set_Return_Object_Declarations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extended_Return_Statement); - Set_List3_With_Parent (N, Val); - end Set_Return_Object_Declarations; - - procedure Set_Return_Statement_Entity - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_Return_Statement_Entity; - - procedure Set_Reverse_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Loop_Parameter_Specification); - Set_Flag15 (N, Val); - end Set_Reverse_Present; - - procedure Set_Right_Opnd - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind in N_Op - or else NT (N).Nkind = N_And_Then - or else NT (N).Nkind = N_In - or else NT (N).Nkind = N_Not_In - or else NT (N).Nkind = N_Or_Else); - Set_Node3_With_Parent (N, Val); - end Set_Right_Opnd; - - procedure Set_Rounded_Result - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Divide - or else NT (N).Nkind = N_Op_Multiply - or else NT (N).Nkind = N_Type_Conversion); - Set_Flag18 (N, Val); - end Set_Rounded_Result; - - procedure Set_Save_Invocation_Graph_Of_Body - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Flag1 (N, Val); - end Set_Save_Invocation_Graph_Of_Body; - - procedure Set_SCIL_Controlling_Tag - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Dispatching_Call); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_SCIL_Controlling_Tag; - - procedure Set_SCIL_Entity - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Dispatch_Table_Tag_Init - or else NT (N).Nkind = N_SCIL_Dispatching_Call - or else NT (N).Nkind = N_SCIL_Membership_Test); - Set_Node4 (N, Val); -- semantic field, no parent set - end Set_SCIL_Entity; - - procedure Set_SCIL_Tag_Value - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Membership_Test); - Set_Node5 (N, Val); -- semantic field, no parent set - end Set_SCIL_Tag_Value; - - procedure Set_SCIL_Target_Prim - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_SCIL_Dispatching_Call); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_SCIL_Target_Prim; - - procedure Set_Scope - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Defining_Character_Literal - or else NT (N).Nkind = N_Defining_Identifier - or else NT (N).Nkind = N_Defining_Operator_Symbol); - Set_Node3 (N, Val); -- semantic field, no parent set - end Set_Scope; - - procedure Set_Select_Alternatives - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Selective_Accept); - Set_List1_With_Parent (N, Val); - end Set_Select_Alternatives; - - procedure Set_Selector_Name - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Expanded_Name - or else NT (N).Nkind = N_Generic_Association - or else NT (N).Nkind = N_Parameter_Association - or else NT (N).Nkind = N_Selected_Component); - Set_Node2_With_Parent (N, Val); - end Set_Selector_Name; - - procedure Set_Selector_Names - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Discriminant_Association); - Set_List1_With_Parent (N, Val); - end Set_Selector_Names; - - procedure Set_Shift_Count_OK - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Op_Rotate_Left - or else NT (N).Nkind = N_Op_Rotate_Right - or else NT (N).Nkind = N_Op_Shift_Left - or else NT (N).Nkind = N_Op_Shift_Right - or else NT (N).Nkind = N_Op_Shift_Right_Arithmetic); - Set_Flag4 (N, Val); - end Set_Shift_Count_OK; - - procedure Set_Source_Type - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Validate_Unchecked_Conversion); - Set_Node1 (N, Val); -- semantic field, no parent set - end Set_Source_Type; - - procedure Set_Specification - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Expression_Function - or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration - or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration - or else NT (N).Nkind = N_Generic_Package_Declaration - or else NT (N).Nkind = N_Generic_Subprogram_Declaration - or else NT (N).Nkind = N_Package_Declaration - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Subprogram_Body_Stub - or else NT (N).Nkind = N_Subprogram_Declaration - or else NT (N).Nkind = N_Subprogram_Renaming_Declaration); - Set_Node1_With_Parent (N, Val); - end Set_Specification; - - procedure Set_Split_PPC - (N : Node_Id; Val : Boolean) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Aspect_Specification - or else NT (N).Nkind = N_Pragma); - Set_Flag17 (N, Val); - end Set_Split_PPC; - - procedure Set_Statements - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Abortable_Part - or else NT (N).Nkind = N_Accept_Alternative - or else NT (N).Nkind = N_Case_Statement_Alternative - or else NT (N).Nkind = N_Delay_Alternative - or else NT (N).Nkind = N_Entry_Call_Alternative - or else NT (N).Nkind = N_Exception_Handler - or else NT (N).Nkind = N_Handled_Sequence_Of_Statements - or else NT (N).Nkind = N_Loop_Statement - or else NT (N).Nkind = N_Triggering_Alternative); - Set_List3_With_Parent (N, Val); - end Set_Statements; - - procedure Set_Storage_Pool - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator - or else NT (N).Nkind = N_Extended_Return_Statement - or else NT (N).Nkind = N_Free_Statement - or else NT (N).Nkind = N_Simple_Return_Statement); - Set_Node1 (N, Val); -- semantic field, no parent set - end Set_Storage_Pool; - - procedure Set_Subpool_Handle_Name - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Allocator); - Set_Node4_With_Parent (N, Val); - end Set_Subpool_Handle_Name; - - procedure Set_Strval - (N : Node_Id; Val : String_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Operator_Symbol - or else NT (N).Nkind = N_String_Literal); - Set_Str3 (N, Val); - end Set_Strval; - - procedure Set_Subtype_Indication - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Component_Definition - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Iterator_Specification - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Subtype_Declaration); - Set_Node5_With_Parent (N, Val); - end Set_Subtype_Indication; - - procedure Set_Subtype_Mark - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Object_Declaration - or else NT (N).Nkind = N_Object_Renaming_Declaration - or else NT (N).Nkind = N_Qualified_Expression - or else NT (N).Nkind = N_Subtype_Indication - or else NT (N).Nkind = N_Type_Conversion - or else NT (N).Nkind = N_Unchecked_Type_Conversion - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Node4_With_Parent (N, Val); - end Set_Subtype_Mark; - - procedure Set_Subtype_Marks - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Unconstrained_Array_Definition); - Set_List2_With_Parent (N, Val); - end Set_Subtype_Marks; - - procedure Set_Suppress_Assignment_Checks - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Assignment_Statement - or else NT (N).Nkind = N_Object_Declaration); - Set_Flag18 (N, Val); - end Set_Suppress_Assignment_Checks; - - procedure Set_Suppress_Loop_Warnings - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Loop_Statement); - Set_Flag17 (N, Val); - end Set_Suppress_Loop_Warnings; - - procedure Set_Synchronized_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Formal_Derived_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Record_Definition); - Set_Flag7 (N, Val); - end Set_Synchronized_Present; - - procedure Set_Tagged_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Incomplete_Type_Definition - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition); - Set_Flag15 (N, Val); - end Set_Tagged_Present; - - procedure Set_Target - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Call_Marker - or else NT (N).Nkind = N_Variable_Reference_Marker); - Set_Node1 (N, Val); -- semantic field, no parent set - end Set_Target; - - procedure Set_Target_Type - (N : Node_Id; Val : Entity_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Validate_Unchecked_Conversion); - Set_Node2 (N, Val); -- semantic field, no parent set - end Set_Target_Type; - - procedure Set_Task_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Single_Task_Declaration - or else NT (N).Nkind = N_Task_Type_Declaration); - Set_Node3_With_Parent (N, Val); - end Set_Task_Definition; - - procedure Set_Task_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Derived_Type_Definition - or else NT (N).Nkind = N_Record_Definition); - Set_Flag5 (N, Val); - end Set_Task_Present; - - procedure Set_Then_Actions - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_If_Expression); - Set_List2_With_Parent (N, Val); -- semantic field, but needs parents - end Set_Then_Actions; - - procedure Set_Then_Statements - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Elsif_Part - or else NT (N).Nkind = N_If_Statement); - Set_List2_With_Parent (N, Val); - end Set_Then_Statements; - - procedure Set_Triggering_Alternative - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Asynchronous_Select); - Set_Node1_With_Parent (N, Val); - end Set_Triggering_Alternative; - - procedure Set_Triggering_Statement - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Triggering_Alternative); - Set_Node1_With_Parent (N, Val); - end Set_Triggering_Statement; - - procedure Set_TSS_Elist - (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Freeze_Entity); - Set_Elist3 (N, Val); -- semantic field, no parent set - end Set_TSS_Elist; - - procedure Set_Uneval_Old_Accept - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag7 (N, Val); - end Set_Uneval_Old_Accept; - - procedure Set_Uneval_Old_Warn - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag18 (N, Val); - end Set_Uneval_Old_Warn; - - procedure Set_Type_Definition - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Full_Type_Declaration); - Set_Node3_With_Parent (N, Val); - end Set_Type_Definition; - - procedure Set_Unit - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Compilation_Unit); - Set_Node2_With_Parent (N, Val); - end Set_Unit; - - procedure Set_Unknown_Discriminants_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Type_Declaration - or else NT (N).Nkind = N_Incomplete_Type_Declaration - or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Private_Type_Declaration); - Set_Flag13 (N, Val); - end Set_Unknown_Discriminants_Present; - - procedure Set_Unreferenced_In_Spec - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_With_Clause); - Set_Flag7 (N, Val); - end Set_Unreferenced_In_Spec; - - procedure Set_Variant_Part - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List); - Set_Node4_With_Parent (N, Val); - end Set_Variant_Part; - - procedure Set_Variants - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Variant_Part); - Set_List1_With_Parent (N, Val); - end Set_Variants; - - procedure Set_Visible_Declarations - (N : Node_Id; Val : List_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Specification - or else NT (N).Nkind = N_Protected_Definition - or else NT (N).Nkind = N_Task_Definition); - Set_List2_With_Parent (N, Val); - end Set_Visible_Declarations; - - procedure Set_Uninitialized_Variable - (N : Node_Id; Val : Node_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Formal_Private_Type_Definition - or else NT (N).Nkind = N_Private_Extension_Declaration); - Set_Node3 (N, Val); - end Set_Uninitialized_Variable; - - procedure Set_Used_Operations - (N : Node_Id; Val : Elist_Id) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Use_Type_Clause); - Set_Elist2 (N, Val); - end Set_Used_Operations; - - procedure Set_Was_Attribute_Reference - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - Set_Flag2 (N, Val); - end Set_Was_Attribute_Reference; - - procedure Set_Was_Default_Init_Box_Association - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_Association); - Set_Flag14 (N, Val); - end Set_Was_Default_Init_Box_Association; - - procedure Set_Was_Expression_Function - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Subprogram_Body); - Set_Flag18 (N, Val); - end Set_Was_Expression_Function; - - procedure Set_Was_Originally_Stub - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Package_Body - or else NT (N).Nkind = N_Protected_Body - or else NT (N).Nkind = N_Subprogram_Body - or else NT (N).Nkind = N_Task_Body); - Set_Flag13 (N, Val); - end Set_Was_Originally_Stub; - - ------------------------- - -- 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; - - --------------------- - -- 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; +pragma No_Body; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index d952b3c2c21..9d8dc09dc37 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -40,13 +40,17 @@ -- WARNING: Several files are automatically generated from this package. -- See below for details. -with Namet; use Namet; -with Types; use Types; -with Uintp; use Uintp; +pragma Warnings (Off); -- with/use clauses for children +with Namet; use Namet; +with Types; use Types; +with Uintp; use Uintp; with Urealp; use Urealp; +pragma Warnings (On); package Sinfo is + -- ????Comments below are partly obsolete + --------------------------------- -- Making Changes to This File -- --------------------------------- @@ -811,6 +815,7 @@ package Sinfo is -- node holding the field. See the individual node types for details of -- how this field is used, as well as the description of the specific use -- for a particular node type. + -- ???Actions is not "-Sem" for all node kinds. -- Activation_Chain_Entity (Node3-Sem) -- This is used in tree nodes representing task activators (blocks, @@ -1091,6 +1096,7 @@ package Sinfo is -- simply contains a copy of the Expression field (both point to the tree -- for the default expression). Default_Expression is used for -- conformance checking. + -- ???Default_Expression is not "-Sem" for all node kinds. -- Default_Storage_Pool (Node3-Sem) -- This field is present in N_Compilation_Unit_Aux nodes. It is set to a @@ -2412,11 +2418,6 @@ package Sinfo is -- instantiation prologue renames these attributes, and expansion later -- converts them into subprogram bodies. - -- Was_Default_Init_Box_Association (Flag14-Sem) - -- Present in N_Component_Association. Set to True if the original source - -- is an aggregate component association with a box (<>) for a component - -- that is initialized by default. - -- Was_Expression_Function (Flag18-Sem) -- Present in N_Subprogram_Body. True if the original source had an -- N_Expression_Function, which was converted to the N_Subprogram_Body @@ -2619,7 +2620,7 @@ package Sinfo is -- Char_Literal_Value (Uint2) contains the literal value -- Entity (Node4-Sem) -- Associated_Node (Node4-Sem) - -- Has_Private_View (Flag11-Sem) set in generic units. + -- Has_Private_View (Flag11-Sem) (set in generic units) -- plus fields for expression -- Note: the Entity field will be missing (set to Empty) for character @@ -4125,7 +4126,6 @@ package Sinfo is -- Expression (Node3) (empty if Box_Present) -- Loop_Actions (List5-Sem) -- Box_Present (Flag15) - -- Was_Default_Init_Box_Association (Flag14) -- Inherited_Discriminant (Flag13) -- Note: this structure is used for both record component associations @@ -4134,9 +4134,7 @@ package Sinfo is -- list of selector names in the record aggregate case, or a list of -- discrete choices in the array aggregate case or an N_Others_Choice -- node (which appears as a singleton list). Box_Present gives support - -- to Ada 2005 (AI-287). Was_Default_Init_Box_Association is used for - -- determining the need for Default_Initial_Condition check on component - -- associations with a box. + -- to Ada 2005 (AI-287). ---------------------------------- -- 4.3.1 Component Choice List -- @@ -4681,7 +4679,7 @@ package Sinfo is -- N_Case_Expression_Alternative -- Sloc points to WHEN - -- Actions (List1) + -- Actions (List1-Sem) -- Discrete_Choices (List4) -- Expression (Node3) -- Has_SP_Choice (Flag15-Sem) @@ -5343,6 +5341,7 @@ package Sinfo is -- Note: the fields of the N_Operator_Symbol node are laid out to match -- the corresponding fields of an N_Character_Literal node. This allows + -- N_Character_Literal???? -- easy conversion of the operator symbol node into a character literal -- node in the case where a string constant of the form of an operator -- symbol is scanned out as such, but turns out semantically to be a @@ -5355,9 +5354,9 @@ package Sinfo is -- Strval (Str3) Id of string value. This is used if the operator -- symbol turns out to be a normal string after all. -- Entity (Node4-Sem) - -- Associated_Node (Node4-Sem) + -- Associated_Node (Node4-Sem) ????Node4 twice -- Etype (Node5-Sem) - -- Has_Private_View (Flag11-Sem) set in generic units + -- Has_Private_View (Flag11-Sem) (set in generic units) -- Note: the Strval field may be set to No_String for generated -- operator symbols that are known not to be string literals @@ -6928,7 +6927,7 @@ package Sinfo is -- Choice_Parameter (Node2) (set to Empty if not present) -- Exception_Choices (List4) -- Statements (List3) - -- Exception_Label (Node5-Sem) (set to Empty of not present) + -- Exception_Label (Node5-Sem) (set to Empty if not present) -- Local_Raise_Statements (Elist1-Sem) (set to No_Elist if not present) -- Local_Raise_Not_OK (Flag7-Sem) -- Has_Local_Raise (Flag8-Sem) @@ -7555,7 +7554,7 @@ package Sinfo is -- Sloc points to aspect identifier -- Identifier (Node1) aspect identifier -- Aspect_Rep_Item (Node2-Sem) - -- Expression (Node3) Aspect_Definition (set to Empty if none) + -- Expression (Node3) (set to Empty if none) -- Entity (Node4-Sem) entity to which the aspect applies -- Next_Rep_Item (Node5-Sem) -- Class_Present (Flag6) Set if 'Class present @@ -8000,7 +7999,7 @@ package Sinfo is -- Is_Elaboration_Checks_OK_Node (Flag1-Sem) -- Is_SPARK_Mode_On_Node (Flag2-Sem) -- Is_Elaboration_Warnings_OK_Node (Flag3-Sem) - -- Has_Private_View (Flag11-Sem) set in generic units + -- Has_Private_View (Flag11-Sem) (set in generic units) -- Redundant_Use (Flag13-Sem) -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression @@ -8562,5304 +8561,9 @@ package Sinfo is -- Chars (Name1) is set to Error_Name -- Etype (Node5-Sem) - -------------------------- - -- Node Type Definition -- - -------------------------- - - -- The following is the definition of the Node_Kind type. As previously - -- discussed, this is separated off to allow rearrangement of the order to - -- facilitate definition of subtype ranges. The comments show the subtype - -- classes which apply to each set of node kinds. The first entry in the - -- comment characterizes the following list of nodes. - - type Node_Kind is ( - N_Unused_At_Start, - - -- N_Representation_Clause - - N_At_Clause, - N_Component_Clause, - N_Enumeration_Representation_Clause, - N_Mod_Clause, - N_Record_Representation_Clause, - - -- N_Representation_Clause, N_Has_Chars - - N_Attribute_Definition_Clause, - - -- N_Has_Chars - - N_Empty, - N_Pragma_Argument_Association, - - -- N_Has_Etype, N_Has_Chars - - -- Note: of course N_Error does not really have Etype or Chars fields, - -- and any attempt to access these fields in N_Error will cause an - -- error, but historically this always has been positioned so that an - -- "in N_Has_Chars" or "in N_Has_Etype" test yields true for N_Error. - -- Most likely this makes coding easier somewhere but still seems - -- undesirable. To be investigated some time ??? - - N_Error, - - -- N_Entity, N_Has_Etype, N_Has_Chars - - N_Defining_Character_Literal, - N_Defining_Identifier, - N_Defining_Operator_Symbol, - - -- N_Subexpr, N_Has_Etype, N_Has_Chars, N_Has_Entity - - N_Expanded_Name, - - -- N_Direct_Name, N_Subexpr, N_Has_Etype, - -- N_Has_Chars, N_Has_Entity - - N_Identifier, - N_Operator_Symbol, - - -- N_Direct_Name, N_Subexpr, N_Has_Etype, - -- N_Has_Chars, N_Has_Entity - - N_Character_Literal, - - -- N_Binary_Op, N_Op, N_Subexpr, - -- N_Has_Etype, N_Has_Chars, N_Has_Entity - - N_Op_Add, - N_Op_Concat, - N_Op_Expon, - N_Op_Subtract, - - -- N_Binary_Op, N_Op, N_Subexpr, - -- N_Has_Etype, N_Has_Chars, N_Has_Entity, N_Multiplying_Operator - - N_Op_Divide, - N_Op_Mod, - N_Op_Multiply, - N_Op_Rem, - - -- N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype - -- N_Has_Entity, N_Has_Chars, N_Op_Boolean - - N_Op_And, - - -- N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype - -- N_Has_Entity, N_Has_Chars, N_Op_Boolean, N_Op_Compare - - N_Op_Eq, - N_Op_Ge, - N_Op_Gt, - N_Op_Le, - N_Op_Lt, - N_Op_Ne, - - -- N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype - -- N_Has_Entity, N_Has_Chars, N_Op_Boolean - - N_Op_Or, - N_Op_Xor, - - -- N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype, - -- N_Op_Shift, N_Has_Chars, N_Has_Entity - - N_Op_Rotate_Left, - N_Op_Rotate_Right, - N_Op_Shift_Left, - N_Op_Shift_Right, - N_Op_Shift_Right_Arithmetic, - - -- N_Unary_Op, N_Op, N_Subexpr, N_Has_Etype, - -- N_Has_Chars, N_Has_Entity - - N_Op_Abs, - N_Op_Minus, - N_Op_Not, - N_Op_Plus, - - -- N_Subexpr, N_Has_Etype, N_Has_Entity - - N_Attribute_Reference, - - -- N_Subexpr, N_Has_Etype, N_Membership_Test - - N_In, - N_Not_In, - - -- N_Subexpr, N_Has_Etype, N_Short_Circuit - - N_And_Then, - N_Or_Else, - - -- N_Subexpr, N_Has_Etype, N_Subprogram_Call - - N_Function_Call, - N_Procedure_Call_Statement, - - -- N_Subexpr, N_Has_Etype, N_Raise_xxx_Error - - N_Raise_Constraint_Error, - N_Raise_Program_Error, - N_Raise_Storage_Error, - - -- N_Subexpr, N_Has_Etype, N_Numeric_Or_String_Literal - - N_Integer_Literal, - N_Real_Literal, - N_String_Literal, - - -- N_Subexpr, N_Has_Etype - - N_Explicit_Dereference, - N_Expression_With_Actions, - N_If_Expression, - N_Indexed_Component, - N_Null, - N_Qualified_Expression, - N_Quantified_Expression, - N_Aggregate, - N_Allocator, - N_Case_Expression, - N_Delta_Aggregate, - N_Extension_Aggregate, - N_Raise_Expression, - N_Range, - N_Reference, - N_Selected_Component, - N_Slice, - N_Target_Name, - N_Type_Conversion, - N_Unchecked_Expression, - N_Unchecked_Type_Conversion, - - -- N_Has_Etype - - N_Subtype_Indication, - - -- N_Declaration - - N_Component_Declaration, - N_Entry_Declaration, - N_Expression_Function, - N_Formal_Object_Declaration, - N_Formal_Type_Declaration, - N_Full_Type_Declaration, - N_Incomplete_Type_Declaration, - N_Iterator_Specification, - N_Loop_Parameter_Specification, - N_Object_Declaration, - N_Protected_Type_Declaration, - N_Private_Extension_Declaration, - N_Private_Type_Declaration, - N_Subtype_Declaration, - - -- N_Subprogram_Specification, N_Declaration - - N_Function_Specification, - N_Procedure_Specification, - - -- N_Access_To_Subprogram_Definition - - N_Access_Function_Definition, - N_Access_Procedure_Definition, - - -- N_Later_Decl_Item - - N_Task_Type_Declaration, - - -- N_Body_Stub, N_Later_Decl_Item - - N_Package_Body_Stub, - N_Protected_Body_Stub, - N_Subprogram_Body_Stub, - N_Task_Body_Stub, - - -- N_Generic_Instantiation, N_Later_Decl_Item - -- N_Subprogram_Instantiation - - N_Function_Instantiation, - N_Procedure_Instantiation, - - -- N_Generic_Instantiation, N_Later_Decl_Item - - N_Package_Instantiation, - - -- N_Unit_Body, N_Later_Decl_Item, N_Proper_Body - - N_Package_Body, - N_Subprogram_Body, - - -- N_Later_Decl_Item, N_Proper_Body - - N_Protected_Body, - N_Task_Body, - - -- N_Later_Decl_Item - - N_Implicit_Label_Declaration, - N_Package_Declaration, - N_Single_Task_Declaration, - N_Subprogram_Declaration, - N_Use_Package_Clause, - - -- N_Generic_Declaration, N_Later_Decl_Item - - N_Generic_Package_Declaration, - N_Generic_Subprogram_Declaration, - - -- N_Array_Type_Definition - - N_Constrained_Array_Definition, - N_Unconstrained_Array_Definition, - - -- N_Renaming_Declaration - - N_Exception_Renaming_Declaration, - N_Object_Renaming_Declaration, - N_Package_Renaming_Declaration, - N_Subprogram_Renaming_Declaration, - - -- N_Generic_Renaming_Declaration, N_Renaming_Declaration - - N_Generic_Function_Renaming_Declaration, - N_Generic_Package_Renaming_Declaration, - N_Generic_Procedure_Renaming_Declaration, - - -- N_Statement_Other_Than_Procedure_Call - - N_Abort_Statement, - N_Accept_Statement, - N_Assignment_Statement, - N_Asynchronous_Select, - N_Block_Statement, - N_Case_Statement, - N_Code_Statement, - N_Compound_Statement, - N_Conditional_Entry_Call, - - -- N_Statement_Other_Than_Procedure_Call, N_Delay_Statement - - N_Delay_Relative_Statement, - N_Delay_Until_Statement, - - -- N_Statement_Other_Than_Procedure_Call - - N_Entry_Call_Statement, - N_Free_Statement, - N_Goto_Statement, - N_Loop_Statement, - N_Null_Statement, - N_Raise_Statement, - N_Requeue_Statement, - N_Simple_Return_Statement, - N_Extended_Return_Statement, - N_Selective_Accept, - N_Timed_Entry_Call, - - -- N_Statement_Other_Than_Procedure_Call, N_Has_Condition - - N_Exit_Statement, - N_If_Statement, - - -- N_Has_Condition - - N_Accept_Alternative, - N_Delay_Alternative, - N_Elsif_Part, - N_Entry_Body_Formal_Part, - N_Iteration_Scheme, - N_Terminate_Alternative, - - -- N_Formal_Subprogram_Declaration - - N_Formal_Abstract_Subprogram_Declaration, - N_Formal_Concrete_Subprogram_Declaration, - - -- N_Push_xxx_Label, N_Push_Pop_xxx_Label - - N_Push_Constraint_Error_Label, - N_Push_Program_Error_Label, - N_Push_Storage_Error_Label, - - -- N_Pop_xxx_Label, N_Push_Pop_xxx_Label - - N_Pop_Constraint_Error_Label, - N_Pop_Program_Error_Label, - N_Pop_Storage_Error_Label, - - -- SCIL nodes - - N_SCIL_Dispatch_Table_Tag_Init, - N_SCIL_Dispatching_Call, - N_SCIL_Membership_Test, - - -- Other nodes (not part of any subtype class) - - N_Abortable_Part, - N_Abstract_Subprogram_Declaration, - N_Access_Definition, - N_Access_To_Object_Definition, - N_Aspect_Specification, - N_Call_Marker, - N_Case_Expression_Alternative, - N_Case_Statement_Alternative, - N_Compilation_Unit, - N_Compilation_Unit_Aux, - N_Component_Association, - N_Component_Definition, - N_Component_List, - N_Contract, - N_Derived_Type_Definition, - N_Decimal_Fixed_Point_Definition, - N_Defining_Program_Unit_Name, - N_Delta_Constraint, - N_Designator, - N_Digits_Constraint, - N_Discriminant_Association, - N_Discriminant_Specification, - N_Enumeration_Type_Definition, - N_Entry_Body, - N_Entry_Call_Alternative, - N_Entry_Index_Specification, - N_Exception_Declaration, - N_Exception_Handler, - N_Floating_Point_Definition, - N_Formal_Decimal_Fixed_Point_Definition, - N_Formal_Derived_Type_Definition, - N_Formal_Discrete_Type_Definition, - N_Formal_Floating_Point_Definition, - N_Formal_Modular_Type_Definition, - N_Formal_Ordinary_Fixed_Point_Definition, - N_Formal_Package_Declaration, - N_Formal_Private_Type_Definition, - N_Formal_Incomplete_Type_Definition, - N_Formal_Signed_Integer_Type_Definition, - N_Freeze_Entity, - N_Freeze_Generic_Entity, - N_Generic_Association, - N_Handled_Sequence_Of_Statements, - N_Index_Or_Discriminant_Constraint, - N_Iterated_Component_Association, - N_Iterated_Element_Association, - N_Itype_Reference, - N_Label, - N_Modular_Type_Definition, - N_Number_Declaration, - N_Ordinary_Fixed_Point_Definition, - N_Others_Choice, - N_Package_Specification, - N_Parameter_Association, - N_Parameter_Specification, - N_Pragma, - N_Protected_Definition, - N_Range_Constraint, - N_Real_Range_Specification, - N_Record_Definition, - N_Signed_Integer_Type_Definition, - N_Single_Protected_Declaration, - N_Subunit, - N_Task_Definition, - N_Triggering_Alternative, - N_Use_Type_Clause, - N_Validate_Unchecked_Conversion, - N_Variable_Reference_Marker, - N_Variant, - N_Variant_Part, - N_With_Clause, - N_Unused_At_End); - - for Node_Kind'Size use 8; - -- The data structures in Atree assume this - - ---------------------------- - -- Node Class Definitions -- - ---------------------------- - - subtype N_Access_To_Subprogram_Definition is Node_Kind range - N_Access_Function_Definition .. - N_Access_Procedure_Definition; - - subtype N_Array_Type_Definition is Node_Kind range - N_Constrained_Array_Definition .. - N_Unconstrained_Array_Definition; - - subtype N_Binary_Op is Node_Kind range - N_Op_Add .. - N_Op_Shift_Right_Arithmetic; - - subtype N_Body_Stub is Node_Kind range - N_Package_Body_Stub .. - N_Task_Body_Stub; - - subtype N_Declaration is Node_Kind range - N_Component_Declaration .. - N_Procedure_Specification; - -- Note: this includes all constructs normally thought of as declarations - -- except those which are separately grouped as later declarations. - - subtype N_Delay_Statement is Node_Kind range - N_Delay_Relative_Statement .. - N_Delay_Until_Statement; - - subtype N_Direct_Name is Node_Kind range - N_Identifier .. - N_Character_Literal; - - subtype N_Entity is Node_Kind range - N_Defining_Character_Literal .. - N_Defining_Operator_Symbol; - - subtype N_Formal_Subprogram_Declaration is Node_Kind range - N_Formal_Abstract_Subprogram_Declaration .. - N_Formal_Concrete_Subprogram_Declaration; - - subtype N_Generic_Declaration is Node_Kind range - N_Generic_Package_Declaration .. - N_Generic_Subprogram_Declaration; - - subtype N_Generic_Instantiation is Node_Kind range - N_Function_Instantiation .. - N_Package_Instantiation; - - subtype N_Generic_Renaming_Declaration is Node_Kind range - N_Generic_Function_Renaming_Declaration .. - N_Generic_Procedure_Renaming_Declaration; - - subtype N_Has_Chars is Node_Kind range - N_Attribute_Definition_Clause .. - N_Op_Plus; - - subtype N_Has_Entity is Node_Kind range - N_Expanded_Name .. - N_Attribute_Reference; - -- Nodes that have Entity fields - -- Warning: DOES NOT INCLUDE N_Freeze_Entity, N_Freeze_Generic_Entity, - -- N_Aspect_Specification, or N_Attribute_Definition_Clause. - - subtype N_Has_Etype is Node_Kind range - N_Error .. - N_Subtype_Indication; - - subtype N_Multiplying_Operator is Node_Kind range - N_Op_Divide .. - N_Op_Rem; - - subtype N_Later_Decl_Item is Node_Kind range - N_Task_Type_Declaration .. - N_Generic_Subprogram_Declaration; - -- Note: this is Ada 83 relevant only (see Ada 83 RM 3.9 (2)) and includes - -- only those items which can appear as later declarative items. This also - -- includes N_Implicit_Label_Declaration which is not specifically in the - -- grammar but may appear as a valid later declarative items. It does NOT - -- include N_Pragma which can also appear among later declarative items. - -- It does however include N_Protected_Body, which is a bit peculiar, but - -- harmless since this cannot appear in Ada 83 mode anyway. - - subtype N_Membership_Test is Node_Kind range - N_In .. - N_Not_In; - - subtype N_Numeric_Or_String_Literal is Node_Kind range - N_Integer_Literal .. - N_String_Literal; - - subtype N_Op is Node_Kind range - N_Op_Add .. - N_Op_Plus; - - subtype N_Op_Boolean is Node_Kind range - N_Op_And .. - N_Op_Xor; - -- Binary operators which take operands of a boolean type, and yield - -- a result of a boolean type. - - subtype N_Op_Compare is Node_Kind range - N_Op_Eq .. - N_Op_Ne; - - subtype N_Op_Shift is Node_Kind range - N_Op_Rotate_Left .. - N_Op_Shift_Right_Arithmetic; - - subtype N_Proper_Body is Node_Kind range - N_Package_Body .. - N_Task_Body; - - subtype N_Push_xxx_Label is Node_Kind range - N_Push_Constraint_Error_Label .. - N_Push_Storage_Error_Label; - - subtype N_Pop_xxx_Label is Node_Kind range - N_Pop_Constraint_Error_Label .. - N_Pop_Storage_Error_Label; - - subtype N_Push_Pop_xxx_Label is Node_Kind range - N_Push_Constraint_Error_Label .. - N_Pop_Storage_Error_Label; - - subtype N_Raise_xxx_Error is Node_Kind range - N_Raise_Constraint_Error .. - N_Raise_Storage_Error; - - subtype N_Renaming_Declaration is Node_Kind range - N_Exception_Renaming_Declaration .. - N_Generic_Procedure_Renaming_Declaration; - - subtype N_Representation_Clause is Node_Kind range - N_At_Clause .. - N_Attribute_Definition_Clause; - - subtype N_Short_Circuit is Node_Kind range - N_And_Then .. - N_Or_Else; - - subtype N_SCIL_Node is Node_Kind range - N_SCIL_Dispatch_Table_Tag_Init .. - N_SCIL_Membership_Test; - - subtype N_Statement_Other_Than_Procedure_Call is Node_Kind range - N_Abort_Statement .. - N_If_Statement; - -- Note that this includes all statement types except for the cases of the - -- N_Procedure_Call_Statement which is considered to be a subexpression - -- (since overloading is possible, so it needs to go through the normal - -- overloading resolution for expressions). - - subtype N_Subprogram_Call is Node_Kind range - N_Function_Call .. - N_Procedure_Call_Statement; - - subtype N_Subprogram_Instantiation is Node_Kind range - N_Function_Instantiation .. - N_Procedure_Instantiation; - - subtype N_Has_Condition is Node_Kind range - N_Exit_Statement .. - N_Terminate_Alternative; - -- Nodes with condition fields (does not include N_Raise_xxx_Error) - - subtype N_Subexpr is Node_Kind range - N_Expanded_Name .. - N_Unchecked_Type_Conversion; - -- Nodes with expression fields - - subtype N_Subprogram_Specification is Node_Kind range - N_Function_Specification .. - N_Procedure_Specification; - - subtype N_Unary_Op is Node_Kind range - N_Op_Abs .. - N_Op_Plus; - - subtype N_Unit_Body is Node_Kind range - N_Package_Body .. - N_Subprogram_Body; - --------------------------- -- Node Access Functions -- --------------------------- - - -- The following functions return the contents of the indicated field of - -- the node referenced by the argument, which is a Node_Id. They provide - -- logical access to fields in the node which could be accessed using the - -- Atree.Unchecked_Access package, but the idea is always to use these - -- higher level routines which preserve strong typing. In debug mode, - -- these routines check that they are being applied to an appropriate - -- node, as well as checking that the node is in range. - - function Abort_Present - (N : Node_Id) return Boolean; -- Flag15 - - function Abortable_Part - (N : Node_Id) return Node_Id; -- Node2 - - function Abstract_Present - (N : Node_Id) return Boolean; -- Flag4 - - function Accept_Handler_Records - (N : Node_Id) return List_Id; -- List5 - - function Accept_Statement - (N : Node_Id) return Node_Id; -- Node2 - - function Access_Definition - (N : Node_Id) return Node_Id; -- Node3 - - function Access_To_Subprogram_Definition - (N : Node_Id) return Node_Id; -- Node3 - - function Access_Types_To_Process - (N : Node_Id) return Elist_Id; -- Elist2 - - function Actions - (N : Node_Id) return List_Id; -- List1 - - function Activation_Chain_Entity - (N : Node_Id) return Node_Id; -- Node3 - - function Acts_As_Spec - (N : Node_Id) return Boolean; -- Flag4 - - function Actual_Designated_Subtype - (N : Node_Id) return Node_Id; -- Node4 - - function Address_Warning_Posted - (N : Node_Id) return Boolean; -- Flag18 - - function Aggregate_Bounds - (N : Node_Id) return Node_Id; -- Node3 - - function Aliased_Present - (N : Node_Id) return Boolean; -- Flag4 - - function Alloc_For_BIP_Return - (N : Node_Id) return Boolean; -- Flag1 - - function All_Others - (N : Node_Id) return Boolean; -- Flag11 - - function All_Present - (N : Node_Id) return Boolean; -- Flag15 - - function Alternatives - (N : Node_Id) return List_Id; -- List4 - - function Ancestor_Part - (N : Node_Id) return Node_Id; -- Node3 - - function Atomic_Sync_Required - (N : Node_Id) return Boolean; -- Flag14 - - function Array_Aggregate - (N : Node_Id) return Node_Id; -- Node3 - - function Aspect_On_Partial_View - (N : Node_Id) return Boolean; -- Flag18 - - function Aspect_Rep_Item - (N : Node_Id) return Node_Id; -- Node2 - - function Assignment_OK - (N : Node_Id) return Boolean; -- Flag15 - - function Associated_Node - (N : Node_Id) return Node_Id; -- Node4 - - function At_End_Proc - (N : Node_Id) return Node_Id; -- Node1 - - function Attribute_Name - (N : Node_Id) return Name_Id; -- Name2 - - function Aux_Decls_Node - (N : Node_Id) return Node_Id; -- Node5 - - function Backwards_OK - (N : Node_Id) return Boolean; -- Flag6 - - function Bad_Is_Detected - (N : Node_Id) return Boolean; -- Flag15 - - function By_Ref - (N : Node_Id) return Boolean; -- Flag5 - - function Body_Required - (N : Node_Id) return Boolean; -- Flag13 - - function Body_To_Inline - (N : Node_Id) return Node_Id; -- Node3 - - function Box_Present - (N : Node_Id) return Boolean; -- Flag15 - - function Char_Literal_Value - (N : Node_Id) return Uint; -- Uint2 - - function Chars - (N : Node_Id) return Name_Id; -- Name1 - - function Check_Address_Alignment - (N : Node_Id) return Boolean; -- Flag11 - - function Choice_Parameter - (N : Node_Id) return Node_Id; -- Node2 - - function Choices - (N : Node_Id) return List_Id; -- List1 - - function Class_Present - (N : Node_Id) return Boolean; -- Flag6 - - function Classifications - (N : Node_Id) return Node_Id; -- Node3 - - function Cleanup_Actions - (N : Node_Id) return List_Id; -- List5 - - function Comes_From_Extended_Return_Statement - (N : Node_Id) return Boolean; -- Flag18 - - function Compile_Time_Known_Aggregate - (N : Node_Id) return Boolean; -- Flag18 - - function Component_Associations - (N : Node_Id) return List_Id; -- List2 - - function Component_Clauses - (N : Node_Id) return List_Id; -- List3 - - function Component_Definition - (N : Node_Id) return Node_Id; -- Node4 - - function Component_Items - (N : Node_Id) return List_Id; -- List3 - - function Component_List - (N : Node_Id) return Node_Id; -- Node1 - - function Component_Name - (N : Node_Id) return Node_Id; -- Node1 - - function Componentwise_Assignment - (N : Node_Id) return Boolean; -- Flag14 - - function Condition - (N : Node_Id) return Node_Id; -- Node1 - - function Condition_Actions - (N : Node_Id) return List_Id; -- List3 - - function Config_Pragmas - (N : Node_Id) return List_Id; -- List4 - - function Constant_Present - (N : Node_Id) return Boolean; -- Flag17 - - function Constraint - (N : Node_Id) return Node_Id; -- Node3 - - function Constraints - (N : Node_Id) return List_Id; -- List1 - - function Context_Installed - (N : Node_Id) return Boolean; -- Flag13 - - function Context_Pending - (N : Node_Id) return Boolean; -- Flag16 - - function Context_Items - (N : Node_Id) return List_Id; -- List1 - - function Contract_Test_Cases - (N : Node_Id) return Node_Id; -- Node2 - - function Controlling_Argument - (N : Node_Id) return Node_Id; -- Node1 - - function Conversion_OK - (N : Node_Id) return Boolean; -- Flag14 - - function Convert_To_Return_False - (N : Node_Id) return Boolean; -- Flag13 - - function Corresponding_Aspect - (N : Node_Id) return Node_Id; -- Node3 - - function Corresponding_Body - (N : Node_Id) return Node_Id; -- Node5 - - function Corresponding_Formal_Spec - (N : Node_Id) return Node_Id; -- Node3 - - function Corresponding_Generic_Association - (N : Node_Id) return Node_Id; -- Node5 - - function Corresponding_Integer_Value - (N : Node_Id) return Uint; -- Uint4 - - function Corresponding_Spec - (N : Node_Id) return Entity_Id; -- Node5 - - function Corresponding_Spec_Of_Stub - (N : Node_Id) return Node_Id; -- Node2 - - function Corresponding_Stub - (N : Node_Id) return Node_Id; -- Node3 - - function Dcheck_Function - (N : Node_Id) return Entity_Id; -- Node5 - - function Declarations - (N : Node_Id) return List_Id; -- List2 - - function Default_Expression - (N : Node_Id) return Node_Id; -- Node5 - - function Default_Storage_Pool - (N : Node_Id) return Node_Id; -- Node3 - - function Default_Name - (N : Node_Id) return Node_Id; -- Node2 - - function Defining_Identifier - (N : Node_Id) return Entity_Id; -- Node1 - - function Defining_Unit_Name - (N : Node_Id) return Node_Id; -- Node1 - - function Delay_Alternative - (N : Node_Id) return Node_Id; -- Node4 - - function Delay_Statement - (N : Node_Id) return Node_Id; -- Node2 - - function Delta_Expression - (N : Node_Id) return Node_Id; -- Node3 - - function Digits_Expression - (N : Node_Id) return Node_Id; -- Node2 - - function Discr_Check_Funcs_Built - (N : Node_Id) return Boolean; -- Flag11 - - function Discrete_Choices - (N : Node_Id) return List_Id; -- List4 - - function Discrete_Range - (N : Node_Id) return Node_Id; -- Node4 - - function Discrete_Subtype_Definition - (N : Node_Id) return Node_Id; -- Node4 - - function Discrete_Subtype_Definitions - (N : Node_Id) return List_Id; -- List2 - - function Discriminant_Specifications - (N : Node_Id) return List_Id; -- List4 - - function Discriminant_Type - (N : Node_Id) return Node_Id; -- Node5 - - function Do_Accessibility_Check - (N : Node_Id) return Boolean; -- Flag13 - - function Do_Discriminant_Check - (N : Node_Id) return Boolean; -- Flag3 - - function Do_Division_Check - (N : Node_Id) return Boolean; -- Flag13 - - function Do_Length_Check - (N : Node_Id) return Boolean; -- Flag4 - - function Do_Overflow_Check - (N : Node_Id) return Boolean; -- Flag17 - - function Do_Range_Check - (N : Node_Id) return Boolean; -- Flag9 - - function Do_Storage_Check - (N : Node_Id) return Boolean; -- Flag17 - - function Do_Tag_Check - (N : Node_Id) return Boolean; -- Flag13 - - function Elaborate_All_Desirable - (N : Node_Id) return Boolean; -- Flag9 - - function Elaborate_All_Present - (N : Node_Id) return Boolean; -- Flag14 - - function Elaborate_Desirable - (N : Node_Id) return Boolean; -- Flag11 - - function Elaborate_Present - (N : Node_Id) return Boolean; -- Flag4 - - function Else_Actions - (N : Node_Id) return List_Id; -- List3 - - function Else_Statements - (N : Node_Id) return List_Id; -- List4 - - function Elsif_Parts - (N : Node_Id) return List_Id; -- List3 - - function Enclosing_Variant - (N : Node_Id) return Node_Id; -- Node2 - - function End_Label - (N : Node_Id) return Node_Id; -- Node4 - - function End_Span - (N : Node_Id) return Uint; -- Uint5 - - function Entity - (N : Node_Id) return Node_Id; -- Node4 - - function Entity_Or_Associated_Node - (N : Node_Id) return Node_Id; -- Node4 - - function Entry_Body_Formal_Part - (N : Node_Id) return Node_Id; -- Node5 - - function Entry_Call_Alternative - (N : Node_Id) return Node_Id; -- Node1 - - function Entry_Call_Statement - (N : Node_Id) return Node_Id; -- Node1 - - function Entry_Direct_Name - (N : Node_Id) return Node_Id; -- Node1 - - function Entry_Index - (N : Node_Id) return Node_Id; -- Node5 - - function Entry_Index_Specification - (N : Node_Id) return Node_Id; -- Node4 - - function Etype - (N : Node_Id) return Node_Id; -- Node5 - - function Exception_Choices - (N : Node_Id) return List_Id; -- List4 - - function Exception_Handlers - (N : Node_Id) return List_Id; -- List5 - - function Exception_Junk - (N : Node_Id) return Boolean; -- Flag8 - - function Exception_Label - (N : Node_Id) return Node_Id; -- Node5 - - function Explicit_Actual_Parameter - (N : Node_Id) return Node_Id; -- Node3 - - function Expansion_Delayed - (N : Node_Id) return Boolean; -- Flag11 - - function Explicit_Generic_Actual_Parameter - (N : Node_Id) return Node_Id; -- Node1 - - function Expression - (N : Node_Id) return Node_Id; -- Node3 - - function Expression_Copy - (N : Node_Id) return Node_Id; -- Node2 - - function Expressions - (N : Node_Id) return List_Id; -- List1 - - function First_Bit - (N : Node_Id) return Node_Id; -- Node3 - - function First_Inlined_Subprogram - (N : Node_Id) return Entity_Id; -- Node3 - - function First_Name - (N : Node_Id) return Boolean; -- Flag5 - - function First_Named_Actual - (N : Node_Id) return Node_Id; -- Node4 - - function First_Real_Statement - (N : Node_Id) return Node_Id; -- Node2 - - function First_Subtype_Link - (N : Node_Id) return Entity_Id; -- Node5 - - function Float_Truncate - (N : Node_Id) return Boolean; -- Flag11 - - function Formal_Type_Definition - (N : Node_Id) return Node_Id; -- Node3 - - function Forwards_OK - (N : Node_Id) return Boolean; -- Flag5 - - function From_Aspect_Specification - (N : Node_Id) return Boolean; -- Flag13 - - function From_At_End - (N : Node_Id) return Boolean; -- Flag4 - - function From_At_Mod - (N : Node_Id) return Boolean; -- Flag4 - - function From_Conditional_Expression - (N : Node_Id) return Boolean; -- Flag1 - - function From_Default - (N : Node_Id) return Boolean; -- Flag6 - - function Generalized_Indexing - (N : Node_Id) return Node_Id; -- Node4 - - function Generic_Associations - (N : Node_Id) return List_Id; -- List3 - - function Generic_Formal_Declarations - (N : Node_Id) return List_Id; -- List2 - - function Generic_Parent - (N : Node_Id) return Node_Id; -- Node5 - - function Generic_Parent_Type - (N : Node_Id) return Node_Id; -- Node4 - - function Handled_Statement_Sequence - (N : Node_Id) return Node_Id; -- Node4 - - function Handler_List_Entry - (N : Node_Id) return Node_Id; -- Node2 - - function Has_Created_Identifier - (N : Node_Id) return Boolean; -- Flag15 - - function Has_Dereference_Action - (N : Node_Id) return Boolean; -- Flag13 - - function Has_Dynamic_Length_Check - (N : Node_Id) return Boolean; -- Flag10 - - function Has_Init_Expression - (N : Node_Id) return Boolean; -- Flag14 - - function Has_Local_Raise - (N : Node_Id) return Boolean; -- Flag8 - - function Has_No_Elaboration_Code - (N : Node_Id) return Boolean; -- Flag17 - - function Has_Pragma_Suppress_All - (N : Node_Id) return Boolean; -- Flag14 - - function Has_Private_View - (N : Node_Id) return Boolean; -- Flag11 - - function Has_Relative_Deadline_Pragma - (N : Node_Id) return Boolean; -- Flag9 - - function Has_Self_Reference - (N : Node_Id) return Boolean; -- Flag13 - - function Has_SP_Choice - (N : Node_Id) return Boolean; -- Flag15 - - function Has_Storage_Size_Pragma - (N : Node_Id) return Boolean; -- Flag5 - - function Has_Target_Names - (N : Node_Id) return Boolean; -- Flag8 - - function Has_Wide_Character - (N : Node_Id) return Boolean; -- Flag11 - - function Has_Wide_Wide_Character - (N : Node_Id) return Boolean; -- Flag13 - - function Header_Size_Added - (N : Node_Id) return Boolean; -- Flag11 - - function Hidden_By_Use_Clause - (N : Node_Id) return Elist_Id; -- Elist5 - - function High_Bound - (N : Node_Id) return Node_Id; -- Node2 - - function Identifier - (N : Node_Id) return Node_Id; -- Node1 - - function Interface_List - (N : Node_Id) return List_Id; -- List2 - - function Interface_Present - (N : Node_Id) return Boolean; -- Flag16 - - function Implicit_With - (N : Node_Id) return Boolean; -- Flag16 - - function Import_Interface_Present - (N : Node_Id) return Boolean; -- Flag16 - - function In_Present - (N : Node_Id) return Boolean; -- Flag15 - - function Includes_Infinities - (N : Node_Id) return Boolean; -- Flag11 - - function Incomplete_View - (N : Node_Id) return Node_Id; -- Node2 - - function Inherited_Discriminant - (N : Node_Id) return Boolean; -- Flag13 - - function Instance_Spec - (N : Node_Id) return Node_Id; -- Node5 - - function Intval - (N : Node_Id) return Uint; -- Uint3 - - function Is_Abort_Block - (N : Node_Id) return Boolean; -- Flag4 - - function Is_Accessibility_Actual - (N : Node_Id) return Boolean; -- Flag13 - - function Is_Analyzed_Pragma - (N : Node_Id) return Boolean; -- Flag5 - - function Is_Asynchronous_Call_Block - (N : Node_Id) return Boolean; -- Flag7 - - function Is_Boolean_Aspect - (N : Node_Id) return Boolean; -- Flag16 - - function Is_Checked - (N : Node_Id) return Boolean; -- Flag11 - - function Is_Checked_Ghost_Pragma - (N : Node_Id) return Boolean; -- Flag3 - - function Is_Component_Left_Opnd - (N : Node_Id) return Boolean; -- Flag13 - - function Is_Component_Right_Opnd - (N : Node_Id) return Boolean; -- Flag14 - - function Is_Controlling_Actual - (N : Node_Id) return Boolean; -- Flag16 - - function Is_Declaration_Level_Node - (N : Node_Id) return Boolean; -- Flag5 - - function Is_Delayed_Aspect - (N : Node_Id) return Boolean; -- Flag14 - - function Is_Disabled - (N : Node_Id) return Boolean; -- Flag15 - - function Is_Dispatching_Call - (N : Node_Id) return Boolean; -- Flag6 - - function Is_Dynamic_Coextension - (N : Node_Id) return Boolean; -- Flag18 - - function Is_Effective_Use_Clause - (N : Node_Id) return Boolean; -- Flag1 - - function Is_Elaboration_Checks_OK_Node - (N : Node_Id) return Boolean; -- Flag1 - - function Is_Elaboration_Code - (N : Node_Id) return Boolean; -- Flag9 - - function Is_Elaboration_Warnings_OK_Node - (N : Node_Id) return Boolean; -- Flag3 - - function Is_Elsif - (N : Node_Id) return Boolean; -- Flag13 - - function Is_Entry_Barrier_Function - (N : Node_Id) return Boolean; -- Flag8 - - function Is_Expanded_Build_In_Place_Call - (N : Node_Id) return Boolean; -- Flag11 - - function Is_Expanded_Contract - (N : Node_Id) return Boolean; -- Flag1 - - function Is_Finalization_Wrapper - (N : Node_Id) return Boolean; -- Flag9 - - function Is_Folded_In_Parser - (N : Node_Id) return Boolean; -- Flag4 - - function Is_Generic_Contract_Pragma - (N : Node_Id) return Boolean; -- Flag2 - - function Is_Homogeneous_Aggregate - (N : Node_Id) return Boolean; -- Flag14 - - function Is_Ignored - (N : Node_Id) return Boolean; -- Flag9 - - function Is_Ignored_Ghost_Pragma - (N : Node_Id) return Boolean; -- Flag8 - - function Is_In_Discriminant_Check - (N : Node_Id) return Boolean; -- Flag11 - - function Is_Inherited_Pragma - (N : Node_Id) return Boolean; -- Flag4 - - function Is_Initialization_Block - (N : Node_Id) return Boolean; -- Flag1 - - function Is_Known_Guaranteed_ABE - (N : Node_Id) return Boolean; -- Flag18 - - function Is_Machine_Number - (N : Node_Id) return Boolean; -- Flag11 - - function Is_Null_Loop - (N : Node_Id) return Boolean; -- Flag16 - - function Is_Overloaded - (N : Node_Id) return Boolean; -- Flag5 - - function Is_Power_Of_2_For_Shift - (N : Node_Id) return Boolean; -- Flag13 - - function Is_Preelaborable_Call - (N : Node_Id) return Boolean; -- Flag7 - - function Is_Prefixed_Call - (N : Node_Id) return Boolean; -- Flag17 - - function Is_Protected_Subprogram_Body - (N : Node_Id) return Boolean; -- Flag7 - - function Is_Qualified_Universal_Literal - (N : Node_Id) return Boolean; -- Flag4 - - function Is_Read - (N : Node_Id) return Boolean; -- Flag4 - - function Is_Source_Call - (N : Node_Id) return Boolean; -- Flag4 - - function Is_SPARK_Mode_On_Node - (N : Node_Id) return Boolean; -- Flag2 - - function Is_Static_Coextension - (N : Node_Id) return Boolean; -- Flag14 - - function Is_Static_Expression - (N : Node_Id) return Boolean; -- Flag6 - - function Is_Subprogram_Descriptor - (N : Node_Id) return Boolean; -- Flag16 - - function Is_Task_Allocation_Block - (N : Node_Id) return Boolean; -- Flag6 - - function Is_Task_Body_Procedure - (N : Node_Id) return Boolean; -- Flag1 - - function Is_Task_Master - (N : Node_Id) return Boolean; -- Flag5 - - function Is_Write - (N : Node_Id) return Boolean; -- Flag5 - - function Iteration_Scheme - (N : Node_Id) return Node_Id; -- Node2 - - function Iterator_Filter - (N : Node_Id) return Node_Id; -- Node3 - - function Iterator_Specification - (N : Node_Id) return Node_Id; -- Node2 - - function Itype - (N : Node_Id) return Entity_Id; -- Node1 - - function Key_Expression - (N : Node_Id) return Node_Id; -- Node1 - - function Kill_Range_Check - (N : Node_Id) return Boolean; -- Flag11 - - function Label_Construct - (N : Node_Id) return Node_Id; -- Node2 - - function Left_Opnd - (N : Node_Id) return Node_Id; -- Node2 - - function Last_Bit - (N : Node_Id) return Node_Id; -- Node4 - - function Last_Name - (N : Node_Id) return Boolean; -- Flag6 - - function Library_Unit - (N : Node_Id) return Node_Id; -- Node4 - - function Limited_View_Installed - (N : Node_Id) return Boolean; -- Flag18 - - function Limited_Present - (N : Node_Id) return Boolean; -- Flag17 - - function Literals - (N : Node_Id) return List_Id; -- List1 - - function Local_Raise_Not_OK - (N : Node_Id) return Boolean; -- Flag7 - - function Local_Raise_Statements - (N : Node_Id) return Elist_Id; -- Elist1 - - function Loop_Actions - (N : Node_Id) return List_Id; -- List5 - - function Loop_Parameter_Specification - (N : Node_Id) return Node_Id; -- Node4 - - function Low_Bound - (N : Node_Id) return Node_Id; -- Node1 - - function Mod_Clause - (N : Node_Id) return Node_Id; -- Node2 - - function More_Ids - (N : Node_Id) return Boolean; -- Flag5 - - function Must_Be_Byte_Aligned - (N : Node_Id) return Boolean; -- Flag14 - - function Must_Not_Freeze - (N : Node_Id) return Boolean; -- Flag8 - - function Must_Not_Override - (N : Node_Id) return Boolean; -- Flag15 - - function Must_Override - (N : Node_Id) return Boolean; -- Flag14 - - function Name - (N : Node_Id) return Node_Id; -- Node2 - - function Names - (N : Node_Id) return List_Id; -- List2 - - function Next_Entity - (N : Node_Id) return Node_Id; -- Node2 - - function Next_Exit_Statement - (N : Node_Id) return Node_Id; -- Node3 - - function Next_Implicit_With - (N : Node_Id) return Node_Id; -- Node3 - - function Next_Named_Actual - (N : Node_Id) return Node_Id; -- Node4 - - function Next_Pragma - (N : Node_Id) return Node_Id; -- Node1 - - function Next_Rep_Item - (N : Node_Id) return Node_Id; -- Node5 - - function Next_Use_Clause - (N : Node_Id) return Node_Id; -- Node3 - - function No_Ctrl_Actions - (N : Node_Id) return Boolean; -- Flag7 - - function No_Elaboration_Check - (N : Node_Id) return Boolean; -- Flag4 - - function No_Entities_Ref_In_Spec - (N : Node_Id) return Boolean; -- Flag8 - - function No_Initialization - (N : Node_Id) return Boolean; -- Flag13 - - function No_Minimize_Eliminate - (N : Node_Id) return Boolean; -- Flag17 - - function No_Side_Effect_Removal - (N : Node_Id) return Boolean; -- Flag17 - - function No_Truncation - (N : Node_Id) return Boolean; -- Flag17 - - function Null_Excluding_Subtype - (N : Node_Id) return Boolean; -- Flag16 - - function Null_Exclusion_Present - (N : Node_Id) return Boolean; -- Flag11 - - function Null_Exclusion_In_Return_Present - (N : Node_Id) return Boolean; -- Flag14 - - function Null_Present - (N : Node_Id) return Boolean; -- Flag13 - - function Null_Record_Present - (N : Node_Id) return Boolean; -- Flag17 - - function Null_Statement - (N : Node_Id) return Node_Id; -- Node2 - - function Object_Definition - (N : Node_Id) return Node_Id; -- Node4 - - function Of_Present - (N : Node_Id) return Boolean; -- Flag16 - - function Original_Discriminant - (N : Node_Id) return Node_Id; -- Node2 - - function Original_Entity - (N : Node_Id) return Entity_Id; -- Node2 - - function Others_Discrete_Choices - (N : Node_Id) return List_Id; -- List1 - - function Out_Present - (N : Node_Id) return Boolean; -- Flag17 - - function Parameter_Associations - (N : Node_Id) return List_Id; -- List3 - - function Parameter_Specifications - (N : Node_Id) return List_Id; -- List3 - - function Parameter_Type - (N : Node_Id) return Node_Id; -- Node2 - - function Parent_Spec - (N : Node_Id) return Node_Id; -- Node4 - - function Parent_With - (N : Node_Id) return Boolean; -- Flag1 - - function Position - (N : Node_Id) return Node_Id; -- Node2 - - function Pragma_Argument_Associations - (N : Node_Id) return List_Id; -- List2 - - function Pragma_Identifier - (N : Node_Id) return Node_Id; -- Node4 - - function Pragmas_After - (N : Node_Id) return List_Id; -- List5 - - function Pragmas_Before - (N : Node_Id) return List_Id; -- List4 - - function Pre_Post_Conditions - (N : Node_Id) return Node_Id; -- Node1 - - function Prefix - (N : Node_Id) return Node_Id; -- Node3 - - function Premature_Use - (N : Node_Id) return Node_Id; -- Node5 - - function Present_Expr - (N : Node_Id) return Uint; -- Uint3 - - function Prev_Ids - (N : Node_Id) return Boolean; -- Flag6 - - function Prev_Use_Clause - (N : Node_Id) return Node_Id; -- Node1 - - function Print_In_Hex - (N : Node_Id) return Boolean; -- Flag13 - - function Private_Declarations - (N : Node_Id) return List_Id; -- List3 - - function Private_Present - (N : Node_Id) return Boolean; -- Flag15 - - function Procedure_To_Call - (N : Node_Id) return Node_Id; -- Node2 - - function Proper_Body - (N : Node_Id) return Node_Id; -- Node1 - - function Protected_Definition - (N : Node_Id) return Node_Id; -- Node3 - - function Protected_Present - (N : Node_Id) return Boolean; -- Flag6 - - function Raises_Constraint_Error - (N : Node_Id) return Boolean; -- Flag7 - - function Range_Constraint - (N : Node_Id) return Node_Id; -- Node4 - - function Range_Expression - (N : Node_Id) return Node_Id; -- Node4 - - function Real_Range_Specification - (N : Node_Id) return Node_Id; -- Node4 - - function Realval - (N : Node_Id) return Ureal; -- Ureal3 - - function Reason - (N : Node_Id) return Uint; -- Uint3 - - function Record_Extension_Part - (N : Node_Id) return Node_Id; -- Node3 - - function Redundant_Use - (N : Node_Id) return Boolean; -- Flag13 - - function Renaming_Exception - (N : Node_Id) return Node_Id; -- Node2 - - function Result_Definition - (N : Node_Id) return Node_Id; -- Node4 - - function Return_Object_Declarations - (N : Node_Id) return List_Id; -- List3 - - function Return_Statement_Entity - (N : Node_Id) return Node_Id; -- Node5 - - function Reverse_Present - (N : Node_Id) return Boolean; -- Flag15 - - function Right_Opnd - (N : Node_Id) return Node_Id; -- Node3 - - function Rounded_Result - (N : Node_Id) return Boolean; -- Flag18 - - function Save_Invocation_Graph_Of_Body - (N : Node_Id) return Boolean; -- Flag1 - - function SCIL_Controlling_Tag - (N : Node_Id) return Node_Id; -- Node5 - - function SCIL_Entity - (N : Node_Id) return Node_Id; -- Node4 - - function SCIL_Tag_Value - (N : Node_Id) return Node_Id; -- Node5 - - function SCIL_Target_Prim - (N : Node_Id) return Node_Id; -- Node2 - - function Scope - (N : Node_Id) return Node_Id; -- Node3 - - function Select_Alternatives - (N : Node_Id) return List_Id; -- List1 - - function Selector_Name - (N : Node_Id) return Node_Id; -- Node2 - - function Selector_Names - (N : Node_Id) return List_Id; -- List1 - - function Shift_Count_OK - (N : Node_Id) return Boolean; -- Flag4 - - function Source_Type - (N : Node_Id) return Entity_Id; -- Node1 - - function Specification - (N : Node_Id) return Node_Id; -- Node1 - - function Split_PPC - (N : Node_Id) return Boolean; -- Flag17 - - function Statements - (N : Node_Id) return List_Id; -- List3 - - function Storage_Pool - (N : Node_Id) return Node_Id; -- Node1 - - function Subpool_Handle_Name - (N : Node_Id) return Node_Id; -- Node4 - - function Strval - (N : Node_Id) return String_Id; -- Str3 - - function Subtype_Indication - (N : Node_Id) return Node_Id; -- Node5 - - function Subtype_Mark - (N : Node_Id) return Node_Id; -- Node4 - - function Subtype_Marks - (N : Node_Id) return List_Id; -- List2 - - function Suppress_Assignment_Checks - (N : Node_Id) return Boolean; -- Flag18 - - function Suppress_Loop_Warnings - (N : Node_Id) return Boolean; -- Flag17 - - function Synchronized_Present - (N : Node_Id) return Boolean; -- Flag7 - - function Tagged_Present - (N : Node_Id) return Boolean; -- Flag15 - - function Target - (N : Node_Id) return Entity_Id; -- Node1 - - function Target_Type - (N : Node_Id) return Entity_Id; -- Node2 - - function Task_Definition - (N : Node_Id) return Node_Id; -- Node3 - - function Task_Present - (N : Node_Id) return Boolean; -- Flag5 - - function Then_Actions - (N : Node_Id) return List_Id; -- List2 - - function Then_Statements - (N : Node_Id) return List_Id; -- List2 - - function Triggering_Alternative - (N : Node_Id) return Node_Id; -- Node1 - - function Triggering_Statement - (N : Node_Id) return Node_Id; -- Node1 - - function TSS_Elist - (N : Node_Id) return Elist_Id; -- Elist3 - - function Type_Definition - (N : Node_Id) return Node_Id; -- Node3 - - function Uneval_Old_Accept - (N : Node_Id) return Boolean; -- Flag7 - - function Uneval_Old_Warn - (N : Node_Id) return Boolean; -- Flag18 - - function Unit - (N : Node_Id) return Node_Id; -- Node2 - - function Unknown_Discriminants_Present - (N : Node_Id) return Boolean; -- Flag13 - - function Unreferenced_In_Spec - (N : Node_Id) return Boolean; -- Flag7 - - function Variant_Part - (N : Node_Id) return Node_Id; -- Node4 - - function Variants - (N : Node_Id) return List_Id; -- List1 - - function Visible_Declarations - (N : Node_Id) return List_Id; -- List2 - - function Uninitialized_Variable - (N : Node_Id) return Node_Id; -- Node3 - - function Used_Operations - (N : Node_Id) return Elist_Id; -- Elist2 - - function Was_Attribute_Reference - (N : Node_Id) return Boolean; -- Flag2 - - function Was_Default_Init_Box_Association - (N : Node_Id) return Boolean; -- Flag14 - - function Was_Expression_Function - (N : Node_Id) return Boolean; -- Flag18 - - function Was_Originally_Stub - (N : Node_Id) return Boolean; -- Flag13 - - -- End functions (note used by xsinfo utility program to end processing) - - ---------------------------- - -- Node Update Procedures -- - ---------------------------- - - -- These are the corresponding node update routines, which again provide - -- a high level logical access with type checking. In addition to setting - -- the indicated field of the node N to the given Val, in the case of - -- tree pointers (List1-4), the parent pointer of the Val node is set to - -- point back to node N. This automates the setting of the parent pointer. - - -- WARNING: There is a matching C declaration of a few subprograms in fe.h - - procedure Set_Abort_Present - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Abortable_Part - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Abstract_Present - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Accept_Handler_Records - (N : Node_Id; Val : List_Id); -- List5 - - procedure Set_Accept_Statement - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Access_Definition - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Access_To_Subprogram_Definition - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Access_Types_To_Process - (N : Node_Id; Val : Elist_Id); -- Elist2 - - procedure Set_Actions - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Activation_Chain_Entity - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Acts_As_Spec - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Actual_Designated_Subtype - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Address_Warning_Posted - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Aggregate_Bounds - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Aliased_Present - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Alloc_For_BIP_Return - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_All_Others - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_All_Present - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Alternatives - (N : Node_Id; Val : List_Id); -- List4 - - procedure Set_Ancestor_Part - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Atomic_Sync_Required - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Array_Aggregate - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Aspect_On_Partial_View - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Aspect_Rep_Item - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Assignment_OK - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Associated_Node - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Attribute_Name - (N : Node_Id; Val : Name_Id); -- Name2 - - procedure Set_At_End_Proc - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Aux_Decls_Node - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Backwards_OK - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Bad_Is_Detected - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Body_Required - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Body_To_Inline - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Box_Present - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_By_Ref - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Char_Literal_Value - (N : Node_Id; Val : Uint); -- Uint2 - - procedure Set_Chars - (N : Node_Id; Val : Name_Id); -- Name1 - - procedure Set_Check_Address_Alignment - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Choice_Parameter - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Choices - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Class_Present - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Classifications - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Cleanup_Actions - (N : Node_Id; Val : List_Id); -- List5 - - procedure Set_Comes_From_Extended_Return_Statement - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Compile_Time_Known_Aggregate - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Component_Associations - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Component_Clauses - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Component_Definition - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Component_Items - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Component_List - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Component_Name - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Componentwise_Assignment - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Condition - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Condition_Actions - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Config_Pragmas - (N : Node_Id; Val : List_Id); -- List4 - - procedure Set_Constant_Present - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Constraint - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Constraints - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Context_Installed - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Context_Items - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Context_Pending - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Contract_Test_Cases - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Controlling_Argument - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Conversion_OK - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Convert_To_Return_False - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Corresponding_Aspect - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Corresponding_Body - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Corresponding_Formal_Spec - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Corresponding_Generic_Association - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Corresponding_Integer_Value - (N : Node_Id; Val : Uint); -- Uint4 - - procedure Set_Corresponding_Spec - (N : Node_Id; Val : Entity_Id); -- Node5 - - procedure Set_Corresponding_Spec_Of_Stub - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Corresponding_Stub - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Dcheck_Function - (N : Node_Id; Val : Entity_Id); -- Node5 - - procedure Set_Declarations - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Default_Expression - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Default_Storage_Pool - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Default_Name - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Defining_Identifier - (N : Node_Id; Val : Entity_Id); -- Node1 - - procedure Set_Defining_Unit_Name - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Delay_Alternative - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Delay_Statement - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Delta_Expression - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Digits_Expression - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Discr_Check_Funcs_Built - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Discrete_Choices - (N : Node_Id; Val : List_Id); -- List4 - - procedure Set_Discrete_Range - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Discrete_Subtype_Definition - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Discrete_Subtype_Definitions - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Discriminant_Specifications - (N : Node_Id; Val : List_Id); -- List4 - - procedure Set_Discriminant_Type - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Do_Accessibility_Check - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Do_Discriminant_Check - (N : Node_Id; Val : Boolean := True); -- Flag3 - - procedure Set_Do_Division_Check - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Do_Length_Check - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Do_Overflow_Check - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Do_Range_Check - (N : Node_Id; Val : Boolean := True); -- Flag9 - - procedure Set_Do_Storage_Check - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Do_Tag_Check - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Elaborate_All_Desirable - (N : Node_Id; Val : Boolean := True); -- Flag9 - - procedure Set_Elaborate_All_Present - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Elaborate_Desirable - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Elaborate_Present - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Else_Actions - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Else_Statements - (N : Node_Id; Val : List_Id); -- List4 - - procedure Set_Elsif_Parts - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Enclosing_Variant - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_End_Label - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_End_Span - (N : Node_Id; Val : Uint); -- Uint5 - - procedure Set_Entity - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Entry_Body_Formal_Part - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Entry_Call_Alternative - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Entry_Call_Statement - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Entry_Direct_Name - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Entry_Index - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Entry_Index_Specification - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Etype - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Exception_Choices - (N : Node_Id; Val : List_Id); -- List4 - - procedure Set_Exception_Handlers - (N : Node_Id; Val : List_Id); -- List5 - - procedure Set_Exception_Junk - (N : Node_Id; Val : Boolean := True); -- Flag8 - - procedure Set_Exception_Label - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Expansion_Delayed - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Explicit_Actual_Parameter - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Explicit_Generic_Actual_Parameter - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Expression - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Expression_Copy - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Expressions - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_First_Bit - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_First_Inlined_Subprogram - (N : Node_Id; Val : Entity_Id); -- Node3 - - procedure Set_First_Name - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_First_Named_Actual - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_First_Real_Statement - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_First_Subtype_Link - (N : Node_Id; Val : Entity_Id); -- Node5 - - procedure Set_Float_Truncate - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Formal_Type_Definition - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Forwards_OK - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_From_Aspect_Specification - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_From_At_End - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_From_At_Mod - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_From_Conditional_Expression - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_From_Default - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Generalized_Indexing - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Generic_Associations - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Generic_Formal_Declarations - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Generic_Parent - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Generic_Parent_Type - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Handled_Statement_Sequence - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Handler_List_Entry - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Has_Created_Identifier - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Has_Dereference_Action - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Has_Dynamic_Length_Check - (N : Node_Id; Val : Boolean := True); -- Flag10 - - procedure Set_Has_Init_Expression - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Has_Local_Raise - (N : Node_Id; Val : Boolean := True); -- Flag8 - - procedure Set_Has_No_Elaboration_Code - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Has_Pragma_Suppress_All - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Has_Private_View - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Has_Relative_Deadline_Pragma - (N : Node_Id; Val : Boolean := True); -- Flag9 - - procedure Set_Has_Self_Reference - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Has_SP_Choice - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Has_Storage_Size_Pragma - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Has_Target_Names - (N : Node_Id; Val : Boolean := True); -- Flag8 - - procedure Set_Has_Wide_Character - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Has_Wide_Wide_Character - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Header_Size_Added - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Hidden_By_Use_Clause - (N : Node_Id; Val : Elist_Id); -- Elist5 - - procedure Set_High_Bound - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Identifier - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Interface_List - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Interface_Present - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Implicit_With - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Import_Interface_Present - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_In_Present - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Includes_Infinities - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Incomplete_View - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Inherited_Discriminant - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Instance_Spec - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Intval - (N : Node_Id; Val : Uint); -- Uint3 - - procedure Set_Is_Abort_Block - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Is_Accessibility_Actual - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Is_Analyzed_Pragma - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Is_Asynchronous_Call_Block - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Is_Boolean_Aspect - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Is_Checked - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Is_Checked_Ghost_Pragma - (N : Node_Id; Val : Boolean := True); -- Flag3 - - procedure Set_Is_Component_Left_Opnd - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Is_Component_Right_Opnd - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Is_Controlling_Actual - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Is_Declaration_Level_Node - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Is_Delayed_Aspect - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Is_Disabled - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Is_Dispatching_Call - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Is_Dynamic_Coextension - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Is_Effective_Use_Clause - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_Is_Elaboration_Checks_OK_Node - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_Is_Elaboration_Code - (N : Node_Id; Val : Boolean := True); -- Flag9 - - procedure Set_Is_Elaboration_Warnings_OK_Node - (N : Node_Id; Val : Boolean := True); -- Flag3 - - procedure Set_Is_Elsif - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Is_Entry_Barrier_Function - (N : Node_Id; Val : Boolean := True); -- Flag8 - - procedure Set_Is_Expanded_Build_In_Place_Call - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Is_Expanded_Contract - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_Is_Finalization_Wrapper - (N : Node_Id; Val : Boolean := True); -- Flag9 - - procedure Set_Is_Folded_In_Parser - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Is_Generic_Contract_Pragma - (N : Node_Id; Val : Boolean := True); -- Flag2 - - procedure Set_Is_Homogeneous_Aggregate - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Is_Ignored - (N : Node_Id; Val : Boolean := True); -- Flag9 - - procedure Set_Is_Ignored_Ghost_Pragma - (N : Node_Id; Val : Boolean := True); -- Flag8 - - procedure Set_Is_In_Discriminant_Check - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Is_Inherited_Pragma - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Is_Initialization_Block - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_Is_Known_Guaranteed_ABE - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Is_Machine_Number - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Is_Null_Loop - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Is_Overloaded - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Is_Power_Of_2_For_Shift - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Is_Preelaborable_Call - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Is_Prefixed_Call - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Is_Protected_Subprogram_Body - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Is_Qualified_Universal_Literal - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Is_Read - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Is_Source_Call - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Is_SPARK_Mode_On_Node - (N : Node_Id; Val : Boolean := True); -- Flag2 - - procedure Set_Is_Static_Coextension - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Is_Static_Expression - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Is_Subprogram_Descriptor - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Is_Task_Allocation_Block - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Is_Task_Body_Procedure - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_Is_Task_Master - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Is_Write - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Iterator_Filter - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Iteration_Scheme - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Iterator_Specification - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Itype - (N : Node_Id; Val : Entity_Id); -- Node1 - - procedure Set_Key_Expression - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Kill_Range_Check - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Last_Bit - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Last_Name - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Library_Unit - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Label_Construct - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Left_Opnd - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Limited_View_Installed - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Limited_Present - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Literals - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Local_Raise_Not_OK - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Local_Raise_Statements - (N : Node_Id; Val : Elist_Id); -- Elist1 - - procedure Set_Loop_Actions - (N : Node_Id; Val : List_Id); -- List5 - - procedure Set_Loop_Parameter_Specification - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Low_Bound - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Mod_Clause - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_More_Ids - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Must_Be_Byte_Aligned - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Must_Not_Freeze - (N : Node_Id; Val : Boolean := True); -- Flag8 - - procedure Set_Must_Not_Override - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Must_Override - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Name - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Names - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Next_Entity - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Next_Exit_Statement - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Next_Implicit_With - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Next_Named_Actual - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Next_Pragma - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Next_Rep_Item - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Next_Use_Clause - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_No_Ctrl_Actions - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_No_Elaboration_Check - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_No_Entities_Ref_In_Spec - (N : Node_Id; Val : Boolean := True); -- Flag8 - - procedure Set_No_Initialization - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_No_Minimize_Eliminate - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_No_Side_Effect_Removal - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_No_Truncation - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Null_Excluding_Subtype - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Null_Exclusion_Present - (N : Node_Id; Val : Boolean := True); -- Flag11 - - procedure Set_Null_Exclusion_In_Return_Present - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Null_Present - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Null_Record_Present - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Null_Statement - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Object_Definition - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Of_Present - (N : Node_Id; Val : Boolean := True); -- Flag16 - - procedure Set_Original_Discriminant - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Original_Entity - (N : Node_Id; Val : Entity_Id); -- Node2 - - procedure Set_Others_Discrete_Choices - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Out_Present - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Parameter_Associations - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Parameter_Specifications - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Parameter_Type - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Parent_Spec - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Parent_With - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_Position - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Pragma_Argument_Associations - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Pragma_Identifier - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Pragmas_After - (N : Node_Id; Val : List_Id); -- List5 - - procedure Set_Pragmas_Before - (N : Node_Id; Val : List_Id); -- List4 - - procedure Set_Pre_Post_Conditions - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Prefix - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Premature_Use - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Present_Expr - (N : Node_Id; Val : Uint); -- Uint3 - - procedure Set_Prev_Ids - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Prev_Use_Clause - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Print_In_Hex - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Private_Declarations - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Private_Present - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Procedure_To_Call - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Proper_Body - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Protected_Definition - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Protected_Present - (N : Node_Id; Val : Boolean := True); -- Flag6 - - procedure Set_Raises_Constraint_Error - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Range_Constraint - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Range_Expression - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Real_Range_Specification - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Realval - (N : Node_Id; Val : Ureal); -- Ureal3 - - procedure Set_Reason - (N : Node_Id; Val : Uint); -- Uint3 - - procedure Set_Record_Extension_Part - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Redundant_Use - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Renaming_Exception - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Result_Definition - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Return_Object_Declarations - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Return_Statement_Entity - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Reverse_Present - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Right_Opnd - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Rounded_Result - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Save_Invocation_Graph_Of_Body - (N : Node_Id; Val : Boolean := True); -- Flag1 - - procedure Set_SCIL_Controlling_Tag - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_SCIL_Entity - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_SCIL_Tag_Value - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_SCIL_Target_Prim - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Scope - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Select_Alternatives - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Selector_Name - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Selector_Names - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Shift_Count_OK - (N : Node_Id; Val : Boolean := True); -- Flag4 - - procedure Set_Source_Type - (N : Node_Id; Val : Entity_Id); -- Node1 - - procedure Set_Specification - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Split_PPC - (N : Node_Id; Val : Boolean); -- Flag17 - - procedure Set_Statements - (N : Node_Id; Val : List_Id); -- List3 - - procedure Set_Storage_Pool - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Subpool_Handle_Name - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Strval - (N : Node_Id; Val : String_Id); -- Str3 - - procedure Set_Subtype_Indication - (N : Node_Id; Val : Node_Id); -- Node5 - - procedure Set_Subtype_Mark - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Subtype_Marks - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Suppress_Assignment_Checks - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Suppress_Loop_Warnings - (N : Node_Id; Val : Boolean := True); -- Flag17 - - procedure Set_Synchronized_Present - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Tagged_Present - (N : Node_Id; Val : Boolean := True); -- Flag15 - - procedure Set_Target - (N : Node_Id; Val : Entity_Id); -- Node1 - - procedure Set_Target_Type - (N : Node_Id; Val : Entity_Id); -- Node2 - - procedure Set_Task_Definition - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Task_Present - (N : Node_Id; Val : Boolean := True); -- Flag5 - - procedure Set_Then_Actions - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Then_Statements - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Triggering_Alternative - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_Triggering_Statement - (N : Node_Id; Val : Node_Id); -- Node1 - - procedure Set_TSS_Elist - (N : Node_Id; Val : Elist_Id); -- Elist3 - - procedure Set_Type_Definition - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Uneval_Old_Accept - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Uneval_Old_Warn - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Unit - (N : Node_Id; Val : Node_Id); -- Node2 - - procedure Set_Unknown_Discriminants_Present - (N : Node_Id; Val : Boolean := True); -- Flag13 - - procedure Set_Unreferenced_In_Spec - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_Variant_Part - (N : Node_Id; Val : Node_Id); -- Node4 - - procedure Set_Variants - (N : Node_Id; Val : List_Id); -- List1 - - procedure Set_Visible_Declarations - (N : Node_Id; Val : List_Id); -- List2 - - procedure Set_Uninitialized_Variable - (N : Node_Id; Val : Node_Id); -- Node3 - - procedure Set_Used_Operations - (N : Node_Id; Val : Elist_Id); -- Elist2 - - procedure Set_Was_Attribute_Reference - (N : Node_Id; Val : Boolean := True); -- Flag2 - - procedure Set_Was_Default_Init_Box_Association - (N : Node_Id; Val : Boolean := True); -- Flag14 - - procedure Set_Was_Expression_Function - (N : Node_Id; Val : Boolean := True); -- Flag18 - - procedure Set_Was_Originally_Stub - (N : Node_Id; Val : Boolean := True); -- Flag13 - - ------------------------- - -- Iterator Procedures -- - ------------------------- - - -- The call to Next_xxx (N) is equivalent to N := Next_xxx (N) - - procedure Next_Entity (N : in out Node_Id); - procedure Next_Named_Actual (N : in out Node_Id); - procedure Next_Rep_Item (N : in out Node_Id); - procedure Next_Use_Clause (N : in out Node_Id); - - ------------------------------------------- - -- Miscellaneous Tree Access Subprograms -- - ------------------------------------------- - - function End_Location (N : Node_Id) return Source_Ptr; - -- N is an N_If_Statement or N_Case_Statement node, and this function - -- returns the location of the IF token in the END IF sequence by - -- translating the value of the End_Span field. - - -- WARNING: There is a matching C declaration of this subprogram in fe.h - - procedure Set_End_Location (N : Node_Id; S : Source_Ptr); - -- N is an N_If_Statement or N_Case_Statement node. This procedure sets - -- the End_Span field to correspond to the given value S. In other words, - -- End_Span is set to the difference between S and Sloc (N), the starting - -- location. - - function Get_Pragma_Arg (Arg : Node_Id) return Node_Id; - -- Given an argument to a pragma Arg, this function returns the expression - -- for the argument. This is Arg itself, or, in the case where Arg is a - -- pragma argument association node, the expression from this node. - - ----------------------- - -- Utility Functions -- - ----------------------- - - procedure Map_Pragma_Name (From, To : Name_Id); - -- Used in the implementation of pragma Rename_Pragma. Maps pragma name - -- From to pragma name To, so From can be used as a synonym for To. - - Too_Many_Pragma_Mappings : exception; - -- Raised if Map_Pragma_Name is called too many times. We expect that few - -- programs will use it at all, and those that do will use it approximately - -- once or twice. - - function Pragma_Name (N : Node_Id) return Name_Id; - -- Obtain the name of pragma N from the Chars field of its identifier. If - -- the pragma has been renamed using Rename_Pragma, this routine returns - -- the name of the renaming. - - function Pragma_Name_Unmapped (N : Node_Id) return Name_Id; - -- Obtain the name of pragma N from the Chars field of its identifier. This - -- form of name extraction does not take into account renamings performed - -- by Rename_Pragma. - - ----------------------------- - -- Syntactic Parent Tables -- - ----------------------------- - - -- These tables show for each node, and for each of the five fields, - -- whether the corresponding field is syntactic (True) or semantic (False). - -- Unused entries are also set to False. - - subtype Field_Num is Natural range 1 .. 5; - - Is_Syntactic_Field : constant array (Node_Kind, Field_Num) of Boolean := ( - - -- Following entries can be built automatically from the sinfo sources - -- using the makeisf utility (currently this program is in spitbol). - - N_Identifier => - (1 => True, -- Chars (Name1) - 2 => False, -- Original_Discriminant (Node2-Sem) - 3 => False, -- unused - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Integer_Literal => - (1 => False, -- unused - 2 => False, -- Original_Entity (Node2-Sem) - 3 => True, -- Intval (Uint3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Real_Literal => - (1 => False, -- unused - 2 => False, -- Original_Entity (Node2-Sem) - 3 => True, -- Realval (Ureal3) - 4 => False, -- Corresponding_Integer_Value (Uint4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Character_Literal => - (1 => True, -- Chars (Name1) - 2 => True, -- Char_Literal_Value (Uint2) - 3 => False, -- unused - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_String_Literal => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Strval (Str3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Pragma => - (1 => False, -- Next_Pragma (Node1-Sem) - 2 => True, -- Pragma_Argument_Associations (List2) - 3 => False, -- Corresponding_Aspect (Node3-Sem) - 4 => True, -- Pragma_Identifier (Node4) - 5 => False), -- Next_Rep_Item (Node5-Sem) - - N_Pragma_Argument_Association => - (1 => True, -- Chars (Name1) - 2 => False, -- Expression_Copy (Node2-Sem) - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Defining_Identifier => - (1 => True, -- Chars (Name1) - 2 => False, -- Next_Entity (Node2-Sem) - 3 => False, -- Scope (Node3-Sem) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Full_Type_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- Incomplete_View (Node2-Sem) - 3 => True, -- Type_Definition (Node3) - 4 => True, -- Discriminant_Specifications (List4) - 5 => False), -- unused - - N_Subtype_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- Generic_Parent_Type (Node4-Sem) - 5 => True), -- Subtype_Indication (Node5) - - N_Subtype_Indication => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Constraint (Node3) - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- Etype (Node5-Sem) - - N_Object_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- Handler_List_Entry (Node2-Sem) - 3 => True, -- Expression (Node3) - 4 => True, -- Object_Definition (Node4) - 5 => False), -- Corresponding_Generic_Association (Node5-Sem) - - N_Number_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Derived_Type_Definition => - (1 => False, -- unused - 2 => True, -- Interface_List (List2) - 3 => True, -- Record_Extension_Part (Node3) - 4 => False, -- unused - 5 => True), -- Subtype_Indication (Node5) - - N_Range_Constraint => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Range_Expression (Node4) - 5 => False), -- unused - - N_Range => - (1 => True, -- Low_Bound (Node1) - 2 => True, -- High_Bound (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Enumeration_Type_Definition => - (1 => True, -- Literals (List1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- End_Label (Node4) - 5 => False), -- unused - - N_Defining_Character_Literal => - (1 => True, -- Chars (Name1) - 2 => False, -- Next_Entity (Node2-Sem) - 3 => False, -- Scope (Node3-Sem) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Signed_Integer_Type_Definition => - (1 => True, -- Low_Bound (Node1) - 2 => True, -- High_Bound (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Modular_Type_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Floating_Point_Definition => - (1 => False, -- unused - 2 => True, -- Digits_Expression (Node2) - 3 => False, -- unused - 4 => True, -- Real_Range_Specification (Node4) - 5 => False), -- unused - - N_Real_Range_Specification => - (1 => True, -- Low_Bound (Node1) - 2 => True, -- High_Bound (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Ordinary_Fixed_Point_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Delta_Expression (Node3) - 4 => True, -- Real_Range_Specification (Node4) - 5 => False), -- unused - - N_Decimal_Fixed_Point_Definition => - (1 => False, -- unused - 2 => True, -- Digits_Expression (Node2) - 3 => True, -- Delta_Expression (Node3) - 4 => True, -- Real_Range_Specification (Node4) - 5 => False), -- unused - - N_Digits_Constraint => - (1 => False, -- unused - 2 => True, -- Digits_Expression (Node2) - 3 => False, -- unused - 4 => True, -- Range_Constraint (Node4) - 5 => False), -- unused - - N_Unconstrained_Array_Definition => - (1 => False, -- unused - 2 => True, -- Subtype_Marks (List2) - 3 => False, -- unused - 4 => True, -- Component_Definition (Node4) - 5 => False), -- unused - - N_Constrained_Array_Definition => - (1 => False, -- unused - 2 => True, -- Discrete_Subtype_Definitions (List2) - 3 => False, -- unused - 4 => True, -- Component_Definition (Node4) - 5 => False), -- unused - - N_Component_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Access_Definition (Node3) - 4 => False, -- unused - 5 => True), -- Subtype_Indication (Node5) - - N_Discriminant_Specification => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => True), -- Discriminant_Type (Node5) - - N_Index_Or_Discriminant_Constraint => - (1 => True, -- Constraints (List1) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Discriminant_Association => - (1 => True, -- Selector_Names (List1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Record_Definition => - (1 => True, -- Component_List (Node1) - 2 => True, -- Interface_List (List2) - 3 => False, -- unused - 4 => True, -- End_Label (Node4) - 5 => False), -- unused - - N_Component_List => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Component_Items (List3) - 4 => True, -- Variant_Part (Node4) - 5 => False), -- unused - - N_Component_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Component_Definition (Node4) - 5 => False), -- unused - - N_Variant_Part => - (1 => True, -- Variants (List1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Variant => - (1 => True, -- Component_List (Node1) - 2 => False, -- Enclosing_Variant (Node2-Sem) - 3 => False, -- Present_Expr (Uint3-Sem) - 4 => True, -- Discrete_Choices (List4) - 5 => False), -- Dcheck_Function (Node5-Sem) - - N_Others_Choice => - (1 => False, -- Others_Discrete_Choices (List1-Sem) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Access_To_Object_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => True), -- Subtype_Indication (Node5) - - N_Access_Function_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Parameter_Specifications (List3) - 4 => True, -- Result_Definition (Node4) - 5 => False), -- unused - - N_Access_Procedure_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Parameter_Specifications (List3) - 4 => False, -- unused - 5 => False), -- unused - - N_Access_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Access_To_Subprogram_Definition (Node3) - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- unused - - N_Incomplete_Type_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Discriminant_Specifications (List4) - 5 => False), -- Premature_Use - - N_Explicit_Dereference => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Prefix (Node3) - 4 => False, -- Actual_Designated_Subtype (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Indexed_Component => - (1 => True, -- Expressions (List1) - 2 => False, -- unused - 3 => True, -- Prefix (Node3) - 4 => False, -- Generalized_Indexing (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Slice => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Prefix (Node3) - 4 => True, -- Discrete_Range (Node4) - 5 => False), -- Etype (Node5-Sem) - - N_Selected_Component => - (1 => False, -- unused - 2 => True, -- Selector_Name (Node2) - 3 => True, -- Prefix (Node3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Attribute_Reference => - (1 => True, -- Expressions (List1) - 2 => True, -- Attribute_Name (Name2) - 3 => True, -- Prefix (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Aggregate => - (1 => True, -- Expressions (List1) - 2 => True, -- Component_Associations (List2) - 3 => False, -- Aggregate_Bounds (Node3-Sem) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Component_Association => - (1 => True, -- Choices (List1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => True), -- Loop_Actions (List5-Sem); - - N_Iterated_Component_Association => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Iterator_Specification - 3 => True, -- Expression (Node3) - 4 => True, -- Discrete_Choices (List4) - 5 => True), -- Loop_Actions (List5-Sem); - - N_Iterated_Element_Association => - (1 => True, -- Key_expression - 2 => True, -- Iterator_Specification - 3 => True, -- Expression (Node3) - 4 => True, -- Loop_Parameter_Specification - 5 => True), -- Loop_Actions (List5-Sem); - - N_Delta_Aggregate => - (1 => False, -- Unused - 2 => True, -- Component_Associations (List2) - 3 => True, -- Expression (Node3) - 4 => False, -- Unused - 5 => False), -- Etype (Node5-Sem) - - N_Extension_Aggregate => - (1 => True, -- Expressions (List1) - 2 => True, -- Component_Associations (List2) - 3 => True, -- Ancestor_Part (Node3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Null => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_And_Then => - (1 => False, -- Actions (List1-Sem) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Or_Else => - (1 => False, -- Actions (List1-Sem) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_In => - (1 => False, -- unused - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => True, -- Alternatives (List4) - 5 => False), -- Etype (Node5-Sem) - - N_Not_In => - (1 => False, -- unused - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => True, -- Alternatives (List4) - 5 => False), -- Etype (Node5-Sem) - - N_Op_And => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Or => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Xor => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Eq => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Ne => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Lt => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Le => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Gt => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Ge => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Add => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Subtract => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Concat => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Multiply => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Divide => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Mod => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Rem => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Expon => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Plus => - (1 => True, -- Chars (Name1) - 2 => False, -- unused - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Minus => - (1 => True, -- Chars (Name1) - 2 => False, -- unused - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Abs => - (1 => True, -- Chars (Name1) - 2 => False, -- unused - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Not => - (1 => True, -- Chars (Name1) - 2 => False, -- unused - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Type_Conversion => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- Etype (Node5-Sem) - - N_Qualified_Expression => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- Etype (Node5-Sem) - - N_Quantified_Expression => - (1 => True, -- Condition (Node1) - 2 => True, -- Iterator_Specification (Node2) - 3 => False, -- unused - 4 => True, -- Loop_Parameter_Specification (Node4) - 5 => False), -- unused - - N_Allocator => - (1 => False, -- Storage_Pool (Node1-Sem) - 2 => False, -- Procedure_To_Call (Node2-Sem) - 3 => True, -- Expression (Node3) - 4 => True, -- Subpool_Handle_Name (Node4) - 5 => False), -- Etype (Node5-Sem) - - N_Null_Statement => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Label => - (1 => True, -- Identifier (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Assignment_Statement => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Target_Name => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_If_Statement => - (1 => True, -- Condition (Node1) - 2 => True, -- Then_Statements (List2) - 3 => True, -- Elsif_Parts (List3) - 4 => True, -- Else_Statements (List4) - 5 => True), -- End_Span (Uint5) - - N_Elsif_Part => - (1 => True, -- Condition (Node1) - 2 => True, -- Then_Statements (List2) - 3 => False, -- Condition_Actions (List3-Sem) - 4 => False, -- unused - 5 => False), -- unused - - N_Case_Expression => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Alternatives (List4) - 5 => False), -- Etype (Node5-Sem) - - N_Case_Expression_Alternative => - (1 => False, -- Actions (List1-Sem) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Discrete_Choices (List4) - 5 => False), -- unused - - N_Case_Statement => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Alternatives (List4) - 5 => True), -- End_Span (Uint5) - - N_Case_Statement_Alternative => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Statements (List3) - 4 => True, -- Discrete_Choices (List4) - 5 => False), -- unused - - N_Loop_Statement => - (1 => True, -- Identifier (Node1) - 2 => True, -- Iteration_Scheme (Node2) - 3 => True, -- Statements (List3) - 4 => True, -- End_Label (Node4) - 5 => False), -- unused - - N_Iteration_Scheme => - (1 => True, -- Condition (Node1) - 2 => True, -- Iterator_Specification (Node2) - 3 => False, -- Condition_Actions (List3-Sem) - 4 => True, -- Loop_Parameter_Specification (Node4) - 5 => False), -- unused - - N_Loop_Parameter_Specification => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Discrete_Subtype_Definition (Node4) - 5 => True), -- Iterator_Filter (Node5) - - N_Iterator_Specification => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- Unused - 4 => False, -- Unused - 5 => True), -- Subtype_Indication (Node5) - - N_Block_Statement => - (1 => True, -- Identifier (Node1) - 2 => True, -- Declarations (List2) - 3 => False, -- Activation_Chain_Entity (Node3-Sem) - 4 => True, -- Handled_Statement_Sequence (Node4) - 5 => False), -- unused - - N_Exit_Statement => - (1 => True, -- Condition (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Goto_Statement => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Subprogram_Declaration => - (1 => True, -- Specification (Node1) - 2 => False, -- unused - 3 => False, -- Body_To_Inline (Node3-Sem) - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Abstract_Subprogram_Declaration => - (1 => True, -- Specification (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Function_Specification => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => False, -- unused - 3 => True, -- Parameter_Specifications (List3) - 4 => True, -- Result_Definition (Node4) - 5 => False), -- Generic_Parent (Node5-Sem) - - N_Procedure_Specification => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => False, -- Null_Statement (Node2-Sem) - 3 => True, -- Parameter_Specifications (List3) - 4 => False, -- unused - 5 => False), -- Generic_Parent (Node5-Sem) - - N_Designator => - (1 => True, -- Identifier (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Defining_Program_Unit_Name => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Operator_Symbol => - (1 => True, -- Chars (Name1) - 2 => False, -- unused - 3 => True, -- Strval (Str3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Defining_Operator_Symbol => - (1 => True, -- Chars (Name1) - 2 => False, -- Next_Entity (Node2-Sem) - 3 => False, -- Scope (Node3-Sem) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Parameter_Specification => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Parameter_Type (Node2) - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- Default_Expression (Node5-Sem) - - N_Subprogram_Body => - (1 => True, -- Specification (Node1) - 2 => True, -- Declarations (List2) - 3 => False, -- Activation_Chain_Entity (Node3-Sem) - 4 => True, -- Handled_Statement_Sequence (Node4) - 5 => False), -- Corresponding_Spec (Node5-Sem) - - N_Expression_Function => - (1 => True, -- Specification (Node1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Procedure_Call_Statement => - (1 => False, -- Controlling_Argument (Node1-Sem) - 2 => True, -- Name (Node2) - 3 => True, -- Parameter_Associations (List3) - 4 => False, -- First_Named_Actual (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Function_Call => - (1 => False, -- Controlling_Argument (Node1-Sem) - 2 => True, -- Name (Node2) - 3 => True, -- Parameter_Associations (List3) - 4 => False, -- First_Named_Actual (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Parameter_Association => - (1 => False, -- unused - 2 => True, -- Selector_Name (Node2) - 3 => True, -- Explicit_Actual_Parameter (Node3) - 4 => False, -- Next_Named_Actual (Node4-Sem) - 5 => False), -- unused - - N_Simple_Return_Statement => - (1 => False, -- Storage_Pool (Node1-Sem) - 2 => False, -- Procedure_To_Call (Node2-Sem) - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- Return_Statement_Entity (Node5-Sem) - - N_Extended_Return_Statement => - (1 => False, -- Storage_Pool (Node1-Sem) - 2 => False, -- Procedure_To_Call (Node2-Sem) - 3 => True, -- Return_Object_Declarations (List3) - 4 => True, -- Handled_Statement_Sequence (Node4) - 5 => False), -- Return_Statement_Entity (Node5-Sem) - - N_Package_Declaration => - (1 => True, -- Specification (Node1) - 2 => False, -- unused - 3 => False, -- Activation_Chain_Entity (Node3-Sem) - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Package_Specification => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Visible_Declarations (List2) - 3 => True, -- Private_Declarations (List3) - 4 => True, -- End_Label (Node4) - 5 => False), -- Generic_Parent (Node5-Sem) - - N_Package_Body => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Declarations (List2) - 3 => False, -- unused - 4 => True, -- Handled_Statement_Sequence (Node4) - 5 => False), -- Corresponding_Spec (Node5-Sem) - - N_Private_Type_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Discriminant_Specifications (List4) - 5 => False), -- unused - - N_Private_Extension_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Interface_List (List2) - 3 => False, -- unused - 4 => True, -- Discriminant_Specifications (List4) - 5 => True), -- Subtype_Indication (Node5) - - N_Use_Package_Clause => - (1 => False, -- Prev_Use_Clause (Node1-Sem) - 2 => True, -- Name (Node2) - 3 => False, -- Next_Use_Clause (Node3-Sem) - 4 => False, -- Associated_Node (Node4-Sem) - 5 => False), -- Hidden_By_Use_Clause (Elist5-Sem) - - N_Use_Type_Clause => - (1 => False, -- Prev_Use_Clause (Node1-Sem) - 2 => False, -- Used_Operations (Elist2-Sem) - 3 => False, -- Next_Use_Clause (Node3-Sem) - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- Hidden_By_Use_Clause (Elist5-Sem) - - N_Object_Renaming_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Name (Node2) - 3 => True, -- Access_Definition (Node3) - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- Corresponding_Generic_Association (Node5-Sem) - - N_Exception_Renaming_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Package_Renaming_Declaration => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- unused - - N_Subprogram_Renaming_Declaration => - (1 => True, -- Specification (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- Corresponding_Formal_Spec (Node3-Sem) - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Corresponding_Spec (Node5-Sem) - - N_Generic_Package_Renaming_Declaration => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- unused - - N_Generic_Procedure_Renaming_Declaration => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- unused - - N_Generic_Function_Renaming_Declaration => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- unused - - N_Task_Type_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Interface_List (List2) - 3 => True, -- Task_Definition (Node3) - 4 => True, -- Discriminant_Specifications (List4) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Single_Task_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Interface_List (List2) - 3 => True, -- Task_Definition (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Task_Definition => - (1 => False, -- unused - 2 => True, -- Visible_Declarations (List2) - 3 => True, -- Private_Declarations (List3) - 4 => True, -- End_Label (Node4) - 5 => False), -- unused - - N_Task_Body => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Declarations (List2) - 3 => False, -- Activation_Chain_Entity (Node3-Sem) - 4 => True, -- Handled_Statement_Sequence (Node4) - 5 => False), -- Corresponding_Spec (Node5-Sem) - - N_Protected_Type_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Interface_List (List2) - 3 => True, -- Protected_Definition (Node3) - 4 => True, -- Discriminant_Specifications (List4) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Single_Protected_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Interface_List (List2) - 3 => True, -- Protected_Definition (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Protected_Definition => - (1 => False, -- unused - 2 => True, -- Visible_Declarations (List2) - 3 => True, -- Private_Declarations (List3) - 4 => True, -- End_Label (Node4) - 5 => False), -- unused - - N_Protected_Body => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Declarations (List2) - 3 => False, -- unused - 4 => True, -- End_Label (Node4) - 5 => False), -- Corresponding_Spec (Node5-Sem) - - N_Entry_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Parameter_Specifications (List3) - 4 => True, -- Discrete_Subtype_Definition (Node4) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Accept_Statement => - (1 => True, -- Entry_Direct_Name (Node1) - 2 => True, -- Declarations (List2) - 3 => True, -- Parameter_Specifications (List3) - 4 => True, -- Handled_Statement_Sequence (Node4) - 5 => True), -- Entry_Index (Node5) - - N_Entry_Body => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Declarations (List2) - 3 => False, -- Activation_Chain_Entity (Node3-Sem) - 4 => True, -- Handled_Statement_Sequence (Node4) - 5 => True), -- Entry_Body_Formal_Part (Node5) - - N_Entry_Body_Formal_Part => - (1 => True, -- Condition (Node1) - 2 => False, -- unused - 3 => True, -- Parameter_Specifications (List3) - 4 => True, -- Entry_Index_Specification (Node4) - 5 => False), -- unused - - N_Entry_Index_Specification => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Discrete_Subtype_Definition (Node4) - 5 => False), -- unused - - N_Entry_Call_Statement => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => True, -- Parameter_Associations (List3) - 4 => False, -- First_Named_Actual (Node4-Sem) - 5 => False), -- unused - - N_Requeue_Statement => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Delay_Until_Statement => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Delay_Relative_Statement => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Selective_Accept => - (1 => True, -- Select_Alternatives (List1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Else_Statements (List4) - 5 => False), -- unused - - N_Accept_Alternative => - (1 => True, -- Condition (Node1) - 2 => True, -- Accept_Statement (Node2) - 3 => True, -- Statements (List3) - 4 => True, -- Pragmas_Before (List4) - 5 => False), -- Accept_Handler_Records (List5-Sem) - - N_Delay_Alternative => - (1 => True, -- Condition (Node1) - 2 => True, -- Delay_Statement (Node2) - 3 => True, -- Statements (List3) - 4 => True, -- Pragmas_Before (List4) - 5 => False), -- unused - - N_Terminate_Alternative => - (1 => True, -- Condition (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Pragmas_Before (List4) - 5 => True), -- Pragmas_After (List5) - - N_Timed_Entry_Call => - (1 => True, -- Entry_Call_Alternative (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Delay_Alternative (Node4) - 5 => False), -- unused - - N_Entry_Call_Alternative => - (1 => True, -- Entry_Call_Statement (Node1) - 2 => False, -- unused - 3 => True, -- Statements (List3) - 4 => True, -- Pragmas_Before (List4) - 5 => False), -- unused - - N_Conditional_Entry_Call => - (1 => True, -- Entry_Call_Alternative (Node1) - 2 => False, -- unused - 3 => False, -- unused - 4 => True, -- Else_Statements (List4) - 5 => False), -- unused - - N_Asynchronous_Select => - (1 => True, -- Triggering_Alternative (Node1) - 2 => True, -- Abortable_Part (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Triggering_Alternative => - (1 => True, -- Triggering_Statement (Node1) - 2 => False, -- unused - 3 => True, -- Statements (List3) - 4 => True, -- Pragmas_Before (List4) - 5 => False), -- unused - - N_Abortable_Part => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Statements (List3) - 4 => False, -- unused - 5 => False), -- unused - - N_Abort_Statement => - (1 => False, -- unused - 2 => True, -- Names (List2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Compilation_Unit => - (1 => True, -- Context_Items (List1) - 2 => True, -- Unit (Node2) - 3 => False, -- First_Inlined_Subprogram (Node3-Sem) - 4 => False, -- Library_Unit (Node4-Sem) - 5 => True), -- Aux_Decls_Node (Node5) - - N_Compilation_Unit_Aux => - (1 => True, -- Actions (List1) - 2 => True, -- Declarations (List2) - 3 => False, -- Default_Storage_Pool (Node3) - 4 => True, -- Config_Pragmas (List4) - 5 => True), -- Pragmas_After (List5) - - N_With_Clause => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- Library_Unit (Node4-Sem) - 5 => False), -- Corresponding_Spec (Node5-Sem) - - N_Subprogram_Body_Stub => - (1 => True, -- Specification (Node1) - 2 => False, -- Corresponding_Spec_Of_Stub (Node2-Sem) - 3 => False, -- unused - 4 => False, -- Library_Unit (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Package_Body_Stub => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- Corresponding_Spec_Of_Stub (Node2-Sem) - 3 => False, -- unused - 4 => False, -- Library_Unit (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Task_Body_Stub => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- Corresponding_Spec_Of_Stub (Node2-Sem) - 3 => False, -- unused - 4 => False, -- Library_Unit (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Protected_Body_Stub => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- Corresponding_Spec_Of_Stub (Node2-Sem) - 3 => False, -- unused - 4 => False, -- Library_Unit (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Subunit => - (1 => True, -- Proper_Body (Node1) - 2 => True, -- Name (Node2) - 3 => False, -- Corresponding_Stub (Node3-Sem) - 4 => False, -- unused - 5 => False), -- unused - - N_Exception_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => False, -- Expression (Node3-Sem) - 4 => False, -- unused - 5 => False), -- unused - - N_Handled_Sequence_Of_Statements => - (1 => True, -- At_End_Proc (Node1) - 2 => False, -- First_Real_Statement (Node2-Sem) - 3 => True, -- Statements (List3) - 4 => True, -- End_Label (Node4) - 5 => True), -- Exception_Handlers (List5) - - N_Exception_Handler => - (1 => False, -- Local_Raise_Statements (Elist1) - 2 => True, -- Choice_Parameter (Node2) - 3 => True, -- Statements (List3) - 4 => True, -- Exception_Choices (List4) - 5 => False), -- Exception_Label (Node5) - - N_Raise_Statement => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Raise_Expression => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Generic_Subprogram_Declaration => - (1 => True, -- Specification (Node1) - 2 => True, -- Generic_Formal_Declarations (List2) - 3 => False, -- unused - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Generic_Package_Declaration => - (1 => True, -- Specification (Node1) - 2 => True, -- Generic_Formal_Declarations (List2) - 3 => False, -- Activation_Chain_Entity (Node3-Sem) - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Corresponding_Body (Node5-Sem) - - N_Package_Instantiation => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Name (Node2) - 3 => True, -- Generic_Associations (List3) - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Instance_Spec (Node5-Sem) - - N_Procedure_Instantiation => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Name (Node2) - 3 => True, -- Generic_Associations (List3) - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Instance_Spec (Node5-Sem) - - N_Function_Instantiation => - (1 => True, -- Defining_Unit_Name (Node1) - 2 => True, -- Name (Node2) - 3 => True, -- Generic_Associations (List3) - 4 => False, -- Parent_Spec (Node4-Sem) - 5 => False), -- Instance_Spec (Node5-Sem) - - N_Generic_Association => - (1 => True, -- Explicit_Generic_Actual_Parameter (Node1) - 2 => True, -- Selector_Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Object_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Access_Definition (Node3) - 4 => True, -- Subtype_Mark (Node4) - 5 => True), -- Default_Expression (Node5) - - N_Formal_Type_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Formal_Type_Definition (Node3) - 4 => True, -- Discriminant_Specifications (List4) - 5 => False), -- unused - - N_Formal_Private_Type_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Incomplete_Type_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Derived_Type_Definition => - (1 => False, -- unused - 2 => True, -- Interface_List (List2) - 3 => False, -- unused - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- unused - - N_Formal_Discrete_Type_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Signed_Integer_Type_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Modular_Type_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Floating_Point_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Ordinary_Fixed_Point_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Decimal_Fixed_Point_Definition => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Concrete_Subprogram_Declaration => - (1 => True, -- Specification (Node1) - 2 => True, -- Default_Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Abstract_Subprogram_Declaration => - (1 => True, -- Specification (Node1) - 2 => True, -- Default_Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Formal_Package_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => True, -- Name (Node2) - 3 => True, -- Generic_Associations (List3) - 4 => False, -- unused - 5 => False), -- Instance_Spec (Node5-Sem) - - N_Attribute_Definition_Clause => - (1 => True, -- Chars (Name1) - 2 => True, -- Name (Node2) - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- Next_Rep_Item (Node5-Sem) - - N_Aspect_Specification => - (1 => True, -- Identifier (Node1) - 2 => False, -- Aspect_Rep_Item (Node2-Sem) - 3 => True, -- Expression (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Next_Rep_Item (Node5-Sem) - - N_Enumeration_Representation_Clause => - (1 => True, -- Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Array_Aggregate (Node3) - 4 => False, -- unused - 5 => False), -- Next_Rep_Item (Node5-Sem) - - N_Record_Representation_Clause => - (1 => True, -- Identifier (Node1) - 2 => True, -- Mod_Clause (Node2) - 3 => True, -- Component_Clauses (List3) - 4 => False, -- unused - 5 => False), -- Next_Rep_Item (Node5-Sem) - - N_Component_Clause => - (1 => True, -- Component_Name (Node1) - 2 => True, -- Position (Node2) - 3 => True, -- First_Bit (Node3) - 4 => True, -- Last_Bit (Node4) - 5 => False), -- unused - - N_Code_Statement => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Op_Rotate_Left => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Rotate_Right => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Shift_Left => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Shift_Right_Arithmetic => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Op_Shift_Right => - (1 => True, -- Chars (Name1) - 2 => True, -- Left_Opnd (Node2) - 3 => True, -- Right_Opnd (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Delta_Constraint => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Delta_Expression (Node3) - 4 => True, -- Range_Constraint (Node4) - 5 => False), -- unused - - N_At_Clause => - (1 => True, -- Identifier (Node1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Mod_Clause => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Pragmas_Before (List4) - 5 => False), -- unused - - N_If_Expression => - (1 => True, -- Expressions (List1) - 2 => False, -- Then_Actions (List2-Sem) - 3 => False, -- Else_Actions (List3-Sem) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Compound_Statement => - (1 => True, -- Actions (List1) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Contract => - (1 => False, -- Pre_Post_Conditions (Node1-Sem) - 2 => False, -- Contract_Test_Cases (Node2-Sem) - 3 => False, -- Classifications (Node3-Sem) - 4 => False, -- unused - 5 => False), -- unused - - N_Expanded_Name => - (1 => True, -- Chars (Name1) - 2 => True, -- Selector_Name (Node2) - 3 => True, -- Prefix (Node3) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- Etype (Node5-Sem) - - N_Expression_With_Actions => - (1 => True, -- Actions (List1) - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- unused - - N_Free_Statement => - (1 => False, -- Storage_Pool (Node1-Sem) - 2 => False, -- Procedure_To_Call (Node2-Sem) - 3 => True, -- Expression (Node3) - 4 => False, -- Actual_Designated_Subtype (Node4-Sem) - 5 => False), -- unused - - N_Freeze_Entity => - (1 => True, -- Actions (List1) - 2 => False, -- Access_Types_To_Process (Elist2-Sem) - 3 => False, -- TSS_Elist (Elist3-Sem) - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- First_Subtype_Link (Node5-Sem) - - N_Freeze_Generic_Entity => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- Entity (Node4-Sem) - 5 => False), -- unused - - N_Implicit_Label_Declaration => - (1 => True, -- Defining_Identifier (Node1) - 2 => False, -- Label_Construct (Node2-Sem) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Itype_Reference => - (1 => False, -- Itype (Node1-Sem) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Raise_Constraint_Error => - (1 => True, -- Condition (Node1) - 2 => False, -- unused - 3 => True, -- Reason (Uint3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Raise_Program_Error => - (1 => True, -- Condition (Node1) - 2 => False, -- unused - 3 => True, -- Reason (Uint3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Raise_Storage_Error => - (1 => True, -- Condition (Node1) - 2 => False, -- unused - 3 => True, -- Reason (Uint3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Push_Constraint_Error_Label => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Push_Program_Error_Label => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- Exception_Label - - N_Push_Storage_Error_Label => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- Exception_Label - - N_Pop_Constraint_Error_Label => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Pop_Program_Error_Label => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Pop_Storage_Error_Label => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Reference => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Prefix (Node3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Unchecked_Expression => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => False, -- unused - 5 => False), -- Etype (Node5-Sem) - - N_Unchecked_Type_Conversion => - (1 => False, -- unused - 2 => False, -- unused - 3 => True, -- Expression (Node3) - 4 => True, -- Subtype_Mark (Node4) - 5 => False), -- Etype (Node5-Sem) - - N_Validate_Unchecked_Conversion => - (1 => False, -- Source_Type (Node1-Sem) - 2 => False, -- Target_Type (Node2-Sem) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - -- Entries for SCIL nodes - - N_SCIL_Dispatch_Table_Tag_Init => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- SCIL_Entity (Node4-Sem) - 5 => False), -- unused - - N_SCIL_Dispatching_Call => - (1 => False, -- unused - 2 => False, -- SCIL_Target_Prim (Node2-Sem) - 3 => False, -- unused - 4 => False, -- SCIL_Entity (Node4-Sem) - 5 => False), -- SCIL_Controlling_Tag (Node5-Sem) - - N_SCIL_Membership_Test => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- SCIL_Entity (Node4-Sem) - 5 => False), -- SCIL_Tag_Value (Node5-Sem) - - N_Call_Marker => - (1 => False, -- Target (Node1-Sem) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Variable_Reference_Marker => - (1 => False, -- Target (Node1-Sem) - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - -- Entries for Empty, Error, and Unused. Even though these have a Chars - -- field for debugging purposes, they are not really syntactic fields, so - -- we mark all fields as unused. - - N_Empty => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Error => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Unused_At_Start => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - - N_Unused_At_End => - (1 => False, -- unused - 2 => False, -- unused - 3 => False, -- unused - 4 => False, -- unused - 5 => False)); -- unused - - -------------------- - -- Inline Pragmas -- - -------------------- - - pragma Inline (Abort_Present); - pragma Inline (Abortable_Part); - pragma Inline (Abstract_Present); - pragma Inline (Accept_Handler_Records); - pragma Inline (Accept_Statement); - pragma Inline (Access_Definition); - pragma Inline (Access_To_Subprogram_Definition); - pragma Inline (Access_Types_To_Process); - pragma Inline (Actions); - pragma Inline (Activation_Chain_Entity); - pragma Inline (Acts_As_Spec); - pragma Inline (Actual_Designated_Subtype); - pragma Inline (Address_Warning_Posted); - pragma Inline (Aggregate_Bounds); - pragma Inline (Aliased_Present); - pragma Inline (Alloc_For_BIP_Return); - pragma Inline (All_Others); - pragma Inline (All_Present); - pragma Inline (Alternatives); - pragma Inline (Ancestor_Part); - pragma Inline (Atomic_Sync_Required); - pragma Inline (Array_Aggregate); - pragma Inline (Aspect_On_Partial_View); - pragma Inline (Aspect_Rep_Item); - pragma Inline (Assignment_OK); - pragma Inline (Associated_Node); - pragma Inline (At_End_Proc); - pragma Inline (Attribute_Name); - pragma Inline (Aux_Decls_Node); - pragma Inline (Backwards_OK); - pragma Inline (Bad_Is_Detected); - pragma Inline (Body_To_Inline); - pragma Inline (Body_Required); - pragma Inline (By_Ref); - pragma Inline (Box_Present); - pragma Inline (Char_Literal_Value); - pragma Inline (Chars); - pragma Inline (Check_Address_Alignment); - pragma Inline (Choice_Parameter); - pragma Inline (Choices); - pragma Inline (Class_Present); - pragma Inline (Classifications); - pragma Inline (Cleanup_Actions); - pragma Inline (Comes_From_Extended_Return_Statement); - pragma Inline (Compile_Time_Known_Aggregate); - pragma Inline (Component_Associations); - pragma Inline (Component_Clauses); - pragma Inline (Component_Definition); - pragma Inline (Component_Items); - pragma Inline (Component_List); - pragma Inline (Component_Name); - pragma Inline (Componentwise_Assignment); - pragma Inline (Condition); - pragma Inline (Condition_Actions); - pragma Inline (Config_Pragmas); - pragma Inline (Constant_Present); - pragma Inline (Constraint); - pragma Inline (Constraints); - pragma Inline (Context_Installed); - pragma Inline (Context_Items); - pragma Inline (Context_Pending); - pragma Inline (Contract_Test_Cases); - pragma Inline (Controlling_Argument); - pragma Inline (Convert_To_Return_False); - pragma Inline (Conversion_OK); - pragma Inline (Corresponding_Aspect); - pragma Inline (Corresponding_Body); - pragma Inline (Corresponding_Formal_Spec); - pragma Inline (Corresponding_Generic_Association); - pragma Inline (Corresponding_Integer_Value); - pragma Inline (Corresponding_Spec); - pragma Inline (Corresponding_Spec_Of_Stub); - pragma Inline (Corresponding_Stub); - pragma Inline (Dcheck_Function); - pragma Inline (Declarations); - pragma Inline (Default_Expression); - pragma Inline (Default_Storage_Pool); - pragma Inline (Default_Name); - pragma Inline (Defining_Identifier); - pragma Inline (Defining_Unit_Name); - pragma Inline (Delay_Alternative); - pragma Inline (Delay_Statement); - pragma Inline (Delta_Expression); - pragma Inline (Digits_Expression); - pragma Inline (Discr_Check_Funcs_Built); - pragma Inline (Discrete_Choices); - pragma Inline (Discrete_Range); - pragma Inline (Discrete_Subtype_Definition); - pragma Inline (Discrete_Subtype_Definitions); - pragma Inline (Discriminant_Specifications); - pragma Inline (Discriminant_Type); - pragma Inline (Do_Accessibility_Check); - pragma Inline (Do_Discriminant_Check); - pragma Inline (Do_Length_Check); - pragma Inline (Do_Division_Check); - pragma Inline (Do_Overflow_Check); - pragma Inline (Do_Range_Check); - pragma Inline (Do_Storage_Check); - pragma Inline (Do_Tag_Check); - pragma Inline (Elaborate_All_Desirable); - pragma Inline (Elaborate_All_Present); - pragma Inline (Elaborate_Desirable); - pragma Inline (Elaborate_Present); - pragma Inline (Else_Actions); - pragma Inline (Else_Statements); - pragma Inline (Elsif_Parts); - pragma Inline (Enclosing_Variant); - pragma Inline (End_Label); - pragma Inline (End_Span); - pragma Inline (Entity); - pragma Inline (Entity_Or_Associated_Node); - pragma Inline (Entry_Body_Formal_Part); - pragma Inline (Entry_Call_Alternative); - pragma Inline (Entry_Call_Statement); - pragma Inline (Entry_Direct_Name); - pragma Inline (Entry_Index); - pragma Inline (Entry_Index_Specification); - pragma Inline (Etype); - pragma Inline (Exception_Choices); - pragma Inline (Exception_Handlers); - pragma Inline (Exception_Junk); - pragma Inline (Exception_Label); - pragma Inline (Expansion_Delayed); - pragma Inline (Explicit_Actual_Parameter); - pragma Inline (Explicit_Generic_Actual_Parameter); - pragma Inline (Expression); - pragma Inline (Expression_Copy); - pragma Inline (Expressions); - pragma Inline (First_Bit); - pragma Inline (First_Inlined_Subprogram); - pragma Inline (First_Name); - pragma Inline (First_Named_Actual); - pragma Inline (First_Real_Statement); - pragma Inline (First_Subtype_Link); - pragma Inline (Float_Truncate); - pragma Inline (Formal_Type_Definition); - pragma Inline (Forwards_OK); - pragma Inline (From_Aspect_Specification); - pragma Inline (From_At_End); - pragma Inline (From_At_Mod); - pragma Inline (From_Conditional_Expression); - pragma Inline (From_Default); - pragma Inline (Generalized_Indexing); - pragma Inline (Generic_Associations); - pragma Inline (Generic_Formal_Declarations); - pragma Inline (Generic_Parent); - pragma Inline (Generic_Parent_Type); - pragma Inline (Handled_Statement_Sequence); - pragma Inline (Handler_List_Entry); - pragma Inline (Has_Created_Identifier); - pragma Inline (Has_Dereference_Action); - pragma Inline (Has_Dynamic_Length_Check); - pragma Inline (Has_Init_Expression); - pragma Inline (Has_Local_Raise); - pragma Inline (Has_Self_Reference); - pragma Inline (Has_SP_Choice); - pragma Inline (Has_No_Elaboration_Code); - pragma Inline (Has_Pragma_Suppress_All); - pragma Inline (Has_Private_View); - pragma Inline (Has_Relative_Deadline_Pragma); - pragma Inline (Has_Storage_Size_Pragma); - pragma Inline (Has_Target_Names); - pragma Inline (Has_Wide_Character); - pragma Inline (Has_Wide_Wide_Character); - pragma Inline (Header_Size_Added); - pragma Inline (Hidden_By_Use_Clause); - pragma Inline (High_Bound); - pragma Inline (Identifier); - pragma Inline (Implicit_With); - pragma Inline (Interface_List); - pragma Inline (Interface_Present); - pragma Inline (Includes_Infinities); - pragma Inline (Import_Interface_Present); - pragma Inline (In_Present); - pragma Inline (Incomplete_View); - pragma Inline (Inherited_Discriminant); - pragma Inline (Instance_Spec); - pragma Inline (Intval); - pragma Inline (Iterator_Specification); - pragma Inline (Is_Abort_Block); - pragma Inline (Is_Accessibility_Actual); - pragma Inline (Is_Analyzed_Pragma); - pragma Inline (Is_Asynchronous_Call_Block); - pragma Inline (Is_Boolean_Aspect); - pragma Inline (Is_Checked); - pragma Inline (Is_Checked_Ghost_Pragma); - pragma Inline (Is_Component_Left_Opnd); - pragma Inline (Is_Component_Right_Opnd); - pragma Inline (Is_Controlling_Actual); - pragma Inline (Is_Declaration_Level_Node); - pragma Inline (Is_Delayed_Aspect); - pragma Inline (Is_Disabled); - pragma Inline (Is_Dispatching_Call); - pragma Inline (Is_Dynamic_Coextension); - pragma Inline (Is_Effective_Use_Clause); - pragma Inline (Is_Elaboration_Checks_OK_Node); - pragma Inline (Is_Elaboration_Code); - pragma Inline (Is_Elaboration_Warnings_OK_Node); - pragma Inline (Is_Elsif); - pragma Inline (Is_Entry_Barrier_Function); - pragma Inline (Is_Expanded_Build_In_Place_Call); - pragma Inline (Is_Expanded_Contract); - pragma Inline (Is_Finalization_Wrapper); - pragma Inline (Is_Folded_In_Parser); - pragma Inline (Is_Generic_Contract_Pragma); - pragma Inline (Is_Homogeneous_Aggregate); - pragma Inline (Is_Ignored); - pragma Inline (Is_Ignored_Ghost_Pragma); - pragma Inline (Is_In_Discriminant_Check); - pragma Inline (Is_Inherited_Pragma); - pragma Inline (Is_Initialization_Block); - pragma Inline (Is_Known_Guaranteed_ABE); - pragma Inline (Is_Machine_Number); - pragma Inline (Is_Null_Loop); - pragma Inline (Is_Overloaded); - pragma Inline (Is_Power_Of_2_For_Shift); - pragma Inline (Is_Preelaborable_Call); - pragma Inline (Is_Prefixed_Call); - pragma Inline (Is_Protected_Subprogram_Body); - pragma Inline (Is_Qualified_Universal_Literal); - pragma Inline (Is_Read); - pragma Inline (Is_Source_Call); - pragma Inline (Is_SPARK_Mode_On_Node); - pragma Inline (Is_Static_Coextension); - pragma Inline (Is_Static_Expression); - pragma Inline (Is_Subprogram_Descriptor); - pragma Inline (Is_Task_Allocation_Block); - pragma Inline (Is_Task_Body_Procedure); - pragma Inline (Is_Task_Master); - pragma Inline (Is_Write); - pragma Inline (Iterator_Filter); - pragma Inline (Iteration_Scheme); - pragma Inline (Itype); - pragma Inline (Key_Expression); - pragma Inline (Kill_Range_Check); - pragma Inline (Last_Bit); - pragma Inline (Last_Name); - pragma Inline (Library_Unit); - pragma Inline (Label_Construct); - pragma Inline (Left_Opnd); - pragma Inline (Limited_View_Installed); - pragma Inline (Limited_Present); - pragma Inline (Literals); - pragma Inline (Local_Raise_Not_OK); - pragma Inline (Local_Raise_Statements); - pragma Inline (Loop_Actions); - pragma Inline (Loop_Parameter_Specification); - pragma Inline (Low_Bound); - pragma Inline (Mod_Clause); - pragma Inline (More_Ids); - pragma Inline (Must_Be_Byte_Aligned); - pragma Inline (Must_Not_Freeze); - pragma Inline (Must_Not_Override); - pragma Inline (Must_Override); - pragma Inline (Name); - pragma Inline (Names); - pragma Inline (Next_Entity); - pragma Inline (Next_Exit_Statement); - pragma Inline (Next_Implicit_With); - pragma Inline (Next_Named_Actual); - pragma Inline (Next_Pragma); - pragma Inline (Next_Rep_Item); - pragma Inline (Next_Use_Clause); - pragma Inline (No_Ctrl_Actions); - pragma Inline (No_Elaboration_Check); - pragma Inline (No_Entities_Ref_In_Spec); - pragma Inline (No_Initialization); - pragma Inline (No_Minimize_Eliminate); - pragma Inline (No_Side_Effect_Removal); - pragma Inline (No_Truncation); - pragma Inline (Null_Excluding_Subtype); - pragma Inline (Null_Exclusion_Present); - pragma Inline (Null_Exclusion_In_Return_Present); - pragma Inline (Null_Present); - pragma Inline (Null_Record_Present); - pragma Inline (Null_Statement); - pragma Inline (Object_Definition); - pragma Inline (Of_Present); - pragma Inline (Original_Discriminant); - pragma Inline (Original_Entity); - pragma Inline (Others_Discrete_Choices); - pragma Inline (Out_Present); - pragma Inline (Parameter_Associations); - pragma Inline (Parameter_Specifications); - pragma Inline (Parameter_Type); - pragma Inline (Parent_Spec); - pragma Inline (Parent_With); - pragma Inline (Position); - pragma Inline (Pragma_Argument_Associations); - pragma Inline (Pragma_Identifier); - pragma Inline (Pragmas_After); - pragma Inline (Pragmas_Before); - pragma Inline (Pre_Post_Conditions); - pragma Inline (Prefix); - pragma Inline (Premature_Use); - pragma Inline (Present_Expr); - pragma Inline (Prev_Ids); - pragma Inline (Prev_Use_Clause); - pragma Inline (Print_In_Hex); - pragma Inline (Private_Declarations); - pragma Inline (Private_Present); - pragma Inline (Procedure_To_Call); - pragma Inline (Proper_Body); - pragma Inline (Protected_Definition); - pragma Inline (Protected_Present); - pragma Inline (Raises_Constraint_Error); - pragma Inline (Range_Constraint); - pragma Inline (Range_Expression); - pragma Inline (Real_Range_Specification); - pragma Inline (Realval); - pragma Inline (Reason); - pragma Inline (Record_Extension_Part); - pragma Inline (Redundant_Use); - pragma Inline (Renaming_Exception); - pragma Inline (Result_Definition); - pragma Inline (Return_Object_Declarations); - pragma Inline (Return_Statement_Entity); - pragma Inline (Reverse_Present); - pragma Inline (Right_Opnd); - pragma Inline (Rounded_Result); - pragma Inline (Save_Invocation_Graph_Of_Body); - pragma Inline (SCIL_Controlling_Tag); - pragma Inline (SCIL_Entity); - pragma Inline (SCIL_Tag_Value); - pragma Inline (SCIL_Target_Prim); - pragma Inline (Scope); - pragma Inline (Select_Alternatives); - pragma Inline (Selector_Name); - pragma Inline (Selector_Names); - pragma Inline (Shift_Count_OK); - pragma Inline (Source_Type); - pragma Inline (Specification); - pragma Inline (Split_PPC); - pragma Inline (Statements); - pragma Inline (Storage_Pool); - pragma Inline (Subpool_Handle_Name); - pragma Inline (Strval); - pragma Inline (Subtype_Indication); - pragma Inline (Subtype_Mark); - pragma Inline (Subtype_Marks); - pragma Inline (Suppress_Assignment_Checks); - pragma Inline (Suppress_Loop_Warnings); - pragma Inline (Synchronized_Present); - pragma Inline (Tagged_Present); - pragma Inline (Target); - pragma Inline (Target_Type); - pragma Inline (Task_Definition); - pragma Inline (Task_Present); - pragma Inline (Then_Actions); - pragma Inline (Then_Statements); - pragma Inline (Triggering_Alternative); - pragma Inline (Triggering_Statement); - pragma Inline (TSS_Elist); - pragma Inline (Type_Definition); - pragma Inline (Uneval_Old_Accept); - pragma Inline (Uneval_Old_Warn); - pragma Inline (Unit); - pragma Inline (Uninitialized_Variable); - pragma Inline (Unknown_Discriminants_Present); - pragma Inline (Unreferenced_In_Spec); - pragma Inline (Variant_Part); - pragma Inline (Variants); - pragma Inline (Visible_Declarations); - pragma Inline (Used_Operations); - pragma Inline (Was_Attribute_Reference); - pragma Inline (Was_Default_Init_Box_Association); - pragma Inline (Was_Expression_Function); - pragma Inline (Was_Originally_Stub); - - pragma Inline (Set_Abort_Present); - pragma Inline (Set_Abortable_Part); - pragma Inline (Set_Abstract_Present); - pragma Inline (Set_Accept_Handler_Records); - pragma Inline (Set_Accept_Statement); - pragma Inline (Set_Access_Definition); - pragma Inline (Set_Access_To_Subprogram_Definition); - pragma Inline (Set_Access_Types_To_Process); - pragma Inline (Set_Actions); - pragma Inline (Set_Activation_Chain_Entity); - pragma Inline (Set_Acts_As_Spec); - pragma Inline (Set_Actual_Designated_Subtype); - pragma Inline (Set_Address_Warning_Posted); - pragma Inline (Set_Aggregate_Bounds); - pragma Inline (Set_Aliased_Present); - pragma Inline (Set_Alloc_For_BIP_Return); - pragma Inline (Set_All_Others); - pragma Inline (Set_All_Present); - pragma Inline (Set_Alternatives); - pragma Inline (Set_Ancestor_Part); - pragma Inline (Set_Array_Aggregate); - pragma Inline (Set_Aspect_On_Partial_View); - pragma Inline (Set_Aspect_Rep_Item); - pragma Inline (Set_Assignment_OK); - pragma Inline (Set_Associated_Node); - pragma Inline (Set_At_End_Proc); - pragma Inline (Set_Atomic_Sync_Required); - pragma Inline (Set_Attribute_Name); - pragma Inline (Set_Aux_Decls_Node); - pragma Inline (Set_Backwards_OK); - pragma Inline (Set_Bad_Is_Detected); - pragma Inline (Set_Body_Required); - pragma Inline (Set_Body_To_Inline); - pragma Inline (Set_Box_Present); - pragma Inline (Set_By_Ref); - pragma Inline (Set_Char_Literal_Value); - pragma Inline (Set_Chars); - pragma Inline (Set_Check_Address_Alignment); - pragma Inline (Set_Choice_Parameter); - pragma Inline (Set_Choices); - pragma Inline (Set_Class_Present); - pragma Inline (Set_Classifications); - pragma Inline (Set_Cleanup_Actions); - pragma Inline (Set_Comes_From_Extended_Return_Statement); - pragma Inline (Set_Compile_Time_Known_Aggregate); - pragma Inline (Set_Component_Associations); - pragma Inline (Set_Component_Clauses); - pragma Inline (Set_Component_Definition); - pragma Inline (Set_Component_Items); - pragma Inline (Set_Component_List); - pragma Inline (Set_Component_Name); - pragma Inline (Set_Componentwise_Assignment); - pragma Inline (Set_Condition); - pragma Inline (Set_Condition_Actions); - pragma Inline (Set_Config_Pragmas); - pragma Inline (Set_Constant_Present); - pragma Inline (Set_Constraint); - pragma Inline (Set_Constraints); - pragma Inline (Set_Context_Installed); - pragma Inline (Set_Context_Items); - pragma Inline (Set_Context_Pending); - pragma Inline (Set_Contract_Test_Cases); - pragma Inline (Set_Controlling_Argument); - pragma Inline (Set_Conversion_OK); - pragma Inline (Set_Convert_To_Return_False); - pragma Inline (Set_Corresponding_Aspect); - pragma Inline (Set_Corresponding_Body); - pragma Inline (Set_Corresponding_Formal_Spec); - pragma Inline (Set_Corresponding_Generic_Association); - pragma Inline (Set_Corresponding_Integer_Value); - pragma Inline (Set_Corresponding_Spec); - pragma Inline (Set_Corresponding_Spec_Of_Stub); - pragma Inline (Set_Corresponding_Stub); - pragma Inline (Set_Dcheck_Function); - pragma Inline (Set_Declarations); - pragma Inline (Set_Default_Expression); - pragma Inline (Set_Default_Name); - pragma Inline (Set_Default_Storage_Pool); - pragma Inline (Set_Defining_Identifier); - pragma Inline (Set_Defining_Unit_Name); - pragma Inline (Set_Delay_Alternative); - pragma Inline (Set_Delay_Statement); - pragma Inline (Set_Delta_Expression); - pragma Inline (Set_Digits_Expression); - pragma Inline (Set_Discr_Check_Funcs_Built); - pragma Inline (Set_Discrete_Choices); - pragma Inline (Set_Discrete_Range); - pragma Inline (Set_Discrete_Subtype_Definition); - pragma Inline (Set_Discrete_Subtype_Definitions); - pragma Inline (Set_Discriminant_Specifications); - pragma Inline (Set_Discriminant_Type); - pragma Inline (Set_Do_Accessibility_Check); - pragma Inline (Set_Do_Discriminant_Check); - pragma Inline (Set_Do_Division_Check); - pragma Inline (Set_Do_Length_Check); - pragma Inline (Set_Do_Overflow_Check); - pragma Inline (Set_Do_Range_Check); - pragma Inline (Set_Do_Storage_Check); - pragma Inline (Set_Do_Tag_Check); - pragma Inline (Set_Elaborate_All_Desirable); - pragma Inline (Set_Elaborate_All_Present); - pragma Inline (Set_Elaborate_Desirable); - pragma Inline (Set_Elaborate_Present); - pragma Inline (Set_Else_Actions); - pragma Inline (Set_Else_Statements); - pragma Inline (Set_Elsif_Parts); - pragma Inline (Set_Enclosing_Variant); - pragma Inline (Set_End_Label); - pragma Inline (Set_End_Span); - pragma Inline (Set_Entity); - pragma Inline (Set_Entry_Body_Formal_Part); - pragma Inline (Set_Entry_Call_Alternative); - pragma Inline (Set_Entry_Call_Statement); - pragma Inline (Set_Entry_Direct_Name); - pragma Inline (Set_Entry_Index); - pragma Inline (Set_Entry_Index_Specification); - pragma Inline (Set_Etype); - pragma Inline (Set_Exception_Choices); - pragma Inline (Set_Exception_Handlers); - pragma Inline (Set_Exception_Junk); - pragma Inline (Set_Exception_Label); - pragma Inline (Set_Expansion_Delayed); - pragma Inline (Set_Explicit_Actual_Parameter); - pragma Inline (Set_Explicit_Generic_Actual_Parameter); - pragma Inline (Set_Expression); - pragma Inline (Set_Expression_Copy); - pragma Inline (Set_Expressions); - pragma Inline (Set_First_Bit); - pragma Inline (Set_First_Inlined_Subprogram); - pragma Inline (Set_First_Name); - pragma Inline (Set_First_Named_Actual); - pragma Inline (Set_First_Real_Statement); - pragma Inline (Set_First_Subtype_Link); - pragma Inline (Set_Float_Truncate); - pragma Inline (Set_Formal_Type_Definition); - pragma Inline (Set_Forwards_OK); - pragma Inline (Set_From_Aspect_Specification); - pragma Inline (Set_From_At_End); - pragma Inline (Set_From_At_Mod); - pragma Inline (Set_From_Conditional_Expression); - pragma Inline (Set_From_Default); - pragma Inline (Set_Generalized_Indexing); - pragma Inline (Set_Generic_Associations); - pragma Inline (Set_Generic_Formal_Declarations); - pragma Inline (Set_Generic_Parent); - pragma Inline (Set_Generic_Parent_Type); - pragma Inline (Set_Handled_Statement_Sequence); - pragma Inline (Set_Handler_List_Entry); - pragma Inline (Set_Has_Created_Identifier); - pragma Inline (Set_Has_Dereference_Action); - pragma Inline (Set_Has_Dynamic_Length_Check); - pragma Inline (Set_Has_Init_Expression); - pragma Inline (Set_Has_Local_Raise); - pragma Inline (Set_Has_No_Elaboration_Code); - pragma Inline (Set_Has_Pragma_Suppress_All); - pragma Inline (Set_Has_Private_View); - pragma Inline (Set_Has_Relative_Deadline_Pragma); - pragma Inline (Set_Has_Self_Reference); - pragma Inline (Set_Has_SP_Choice); - pragma Inline (Set_Has_Storage_Size_Pragma); - pragma Inline (Set_Has_Target_Names); - pragma Inline (Set_Has_Wide_Character); - pragma Inline (Set_Has_Wide_Wide_Character); - pragma Inline (Set_Header_Size_Added); - pragma Inline (Set_Hidden_By_Use_Clause); - pragma Inline (Set_High_Bound); - pragma Inline (Set_Identifier); - pragma Inline (Set_Implicit_With); - pragma Inline (Set_Import_Interface_Present); - pragma Inline (Set_In_Present); - pragma Inline (Set_Includes_Infinities); - pragma Inline (Set_Incomplete_View); - pragma Inline (Set_Inherited_Discriminant); - pragma Inline (Set_Instance_Spec); - pragma Inline (Set_Interface_List); - pragma Inline (Set_Interface_Present); - pragma Inline (Set_Intval); - pragma Inline (Set_Is_Abort_Block); - pragma Inline (Set_Is_Accessibility_Actual); - pragma Inline (Set_Is_Analyzed_Pragma); - pragma Inline (Set_Is_Asynchronous_Call_Block); - pragma Inline (Set_Is_Boolean_Aspect); - pragma Inline (Set_Is_Checked); - pragma Inline (Set_Is_Checked_Ghost_Pragma); - pragma Inline (Set_Is_Component_Left_Opnd); - pragma Inline (Set_Is_Component_Right_Opnd); - pragma Inline (Set_Is_Controlling_Actual); - pragma Inline (Set_Is_Declaration_Level_Node); - pragma Inline (Set_Is_Delayed_Aspect); - pragma Inline (Set_Is_Disabled); - pragma Inline (Set_Is_Dispatching_Call); - pragma Inline (Set_Is_Dynamic_Coextension); - pragma Inline (Set_Is_Effective_Use_Clause); - pragma Inline (Set_Is_Elaboration_Checks_OK_Node); - pragma Inline (Set_Is_Elaboration_Code); - pragma Inline (Set_Is_Elaboration_Warnings_OK_Node); - pragma Inline (Set_Is_Elsif); - pragma Inline (Set_Is_Entry_Barrier_Function); - pragma Inline (Set_Is_Expanded_Build_In_Place_Call); - pragma Inline (Set_Is_Expanded_Contract); - pragma Inline (Set_Is_Finalization_Wrapper); - pragma Inline (Set_Is_Folded_In_Parser); - pragma Inline (Set_Is_Generic_Contract_Pragma); - pragma Inline (Set_Is_Homogeneous_Aggregate); - pragma Inline (Set_Is_Ignored); - pragma Inline (Set_Is_Ignored_Ghost_Pragma); - pragma Inline (Set_Is_In_Discriminant_Check); - pragma Inline (Set_Is_Inherited_Pragma); - pragma Inline (Set_Is_Initialization_Block); - pragma Inline (Set_Is_Known_Guaranteed_ABE); - pragma Inline (Set_Is_Machine_Number); - pragma Inline (Set_Is_Null_Loop); - pragma Inline (Set_Is_Overloaded); - pragma Inline (Set_Is_Power_Of_2_For_Shift); - pragma Inline (Set_Is_Preelaborable_Call); - pragma Inline (Set_Is_Prefixed_Call); - pragma Inline (Set_Is_Protected_Subprogram_Body); - pragma Inline (Set_Is_Qualified_Universal_Literal); - pragma Inline (Set_Is_Read); - pragma Inline (Set_Is_Source_Call); - pragma Inline (Set_Is_SPARK_Mode_On_Node); - pragma Inline (Set_Is_Static_Coextension); - pragma Inline (Set_Is_Static_Expression); - pragma Inline (Set_Is_Subprogram_Descriptor); - pragma Inline (Set_Is_Task_Allocation_Block); - pragma Inline (Set_Is_Task_Body_Procedure); - pragma Inline (Set_Is_Task_Master); - pragma Inline (Set_Is_Write); - pragma Inline (Set_Iterator_Filter); - pragma Inline (Set_Iteration_Scheme); - pragma Inline (Set_Iterator_Specification); - pragma Inline (Set_Itype); - pragma Inline (Set_Key_Expression); - pragma Inline (Set_Kill_Range_Check); - pragma Inline (Set_Label_Construct); - pragma Inline (Set_Last_Bit); - pragma Inline (Set_Last_Name); - pragma Inline (Set_Left_Opnd); - pragma Inline (Set_Library_Unit); - pragma Inline (Set_Limited_Present); - pragma Inline (Set_Limited_View_Installed); - pragma Inline (Set_Literals); - pragma Inline (Set_Local_Raise_Not_OK); - pragma Inline (Set_Local_Raise_Statements); - pragma Inline (Set_Loop_Actions); - pragma Inline (Set_Loop_Parameter_Specification); - pragma Inline (Set_Low_Bound); - pragma Inline (Set_Mod_Clause); - pragma Inline (Set_More_Ids); - pragma Inline (Set_Must_Be_Byte_Aligned); - pragma Inline (Set_Must_Not_Freeze); - pragma Inline (Set_Must_Not_Override); - pragma Inline (Set_Must_Override); - pragma Inline (Set_Name); - pragma Inline (Set_Names); - pragma Inline (Set_Next_Entity); - pragma Inline (Set_Next_Exit_Statement); - pragma Inline (Set_Next_Implicit_With); - pragma Inline (Set_Next_Named_Actual); - pragma Inline (Set_Next_Pragma); - pragma Inline (Set_Next_Rep_Item); - pragma Inline (Set_Next_Use_Clause); - pragma Inline (Set_No_Ctrl_Actions); - pragma Inline (Set_No_Elaboration_Check); - pragma Inline (Set_No_Entities_Ref_In_Spec); - pragma Inline (Set_No_Initialization); - pragma Inline (Set_No_Minimize_Eliminate); - pragma Inline (Set_No_Side_Effect_Removal); - pragma Inline (Set_No_Truncation); - pragma Inline (Set_Null_Excluding_Subtype); - pragma Inline (Set_Null_Exclusion_Present); - pragma Inline (Set_Null_Exclusion_In_Return_Present); - pragma Inline (Set_Null_Present); - pragma Inline (Set_Null_Record_Present); - pragma Inline (Set_Null_Statement); - pragma Inline (Set_Object_Definition); - pragma Inline (Set_Of_Present); - pragma Inline (Set_Original_Discriminant); - pragma Inline (Set_Original_Entity); - pragma Inline (Set_Others_Discrete_Choices); - pragma Inline (Set_Out_Present); - pragma Inline (Set_Parameter_Associations); - pragma Inline (Set_Parameter_Specifications); - pragma Inline (Set_Parameter_Type); - pragma Inline (Set_Parent_Spec); - pragma Inline (Set_Parent_With); - pragma Inline (Set_Position); - pragma Inline (Set_Pragma_Argument_Associations); - pragma Inline (Set_Pragma_Identifier); - pragma Inline (Set_Pragmas_After); - pragma Inline (Set_Pragmas_Before); - pragma Inline (Set_Pre_Post_Conditions); - pragma Inline (Set_Prefix); - pragma Inline (Set_Premature_Use); - pragma Inline (Set_Present_Expr); - pragma Inline (Set_Prev_Ids); - pragma Inline (Set_Prev_Use_Clause); - pragma Inline (Set_Print_In_Hex); - pragma Inline (Set_Private_Declarations); - pragma Inline (Set_Private_Present); - pragma Inline (Set_Procedure_To_Call); - pragma Inline (Set_Proper_Body); - pragma Inline (Set_Protected_Definition); - pragma Inline (Set_Protected_Present); - pragma Inline (Set_Raises_Constraint_Error); - pragma Inline (Set_Range_Constraint); - pragma Inline (Set_Range_Expression); - pragma Inline (Set_Real_Range_Specification); - pragma Inline (Set_Realval); - pragma Inline (Set_Reason); - pragma Inline (Set_Record_Extension_Part); - pragma Inline (Set_Redundant_Use); - pragma Inline (Set_Renaming_Exception); - pragma Inline (Set_Result_Definition); - pragma Inline (Set_Return_Object_Declarations); - pragma Inline (Set_Reverse_Present); - pragma Inline (Set_Right_Opnd); - pragma Inline (Set_Rounded_Result); - pragma Inline (Set_Save_Invocation_Graph_Of_Body); - pragma Inline (Set_SCIL_Controlling_Tag); - pragma Inline (Set_SCIL_Entity); - pragma Inline (Set_SCIL_Tag_Value); - pragma Inline (Set_SCIL_Target_Prim); - pragma Inline (Set_Scope); - pragma Inline (Set_Select_Alternatives); - pragma Inline (Set_Selector_Name); - pragma Inline (Set_Selector_Names); - pragma Inline (Set_Shift_Count_OK); - pragma Inline (Set_Source_Type); - pragma Inline (Set_Split_PPC); - pragma Inline (Set_Statements); - pragma Inline (Set_Storage_Pool); - pragma Inline (Set_Strval); - pragma Inline (Set_Subpool_Handle_Name); - pragma Inline (Set_Subtype_Indication); - pragma Inline (Set_Subtype_Mark); - pragma Inline (Set_Subtype_Marks); - pragma Inline (Set_Suppress_Assignment_Checks); - pragma Inline (Set_Suppress_Loop_Warnings); - pragma Inline (Set_Synchronized_Present); - pragma Inline (Set_TSS_Elist); - pragma Inline (Set_Tagged_Present); - pragma Inline (Set_Target); - pragma Inline (Set_Target_Type); - pragma Inline (Set_Task_Definition); - pragma Inline (Set_Task_Present); - pragma Inline (Set_Then_Actions); - pragma Inline (Set_Then_Statements); - pragma Inline (Set_Triggering_Alternative); - pragma Inline (Set_Triggering_Statement); - pragma Inline (Set_Type_Definition); - pragma Inline (Set_Uneval_Old_Accept); - pragma Inline (Set_Uneval_Old_Warn); - pragma Inline (Set_Unit); - pragma Inline (Set_Uninitialized_Variable); - pragma Inline (Set_Unknown_Discriminants_Present); - pragma Inline (Set_Unreferenced_In_Spec); - pragma Inline (Set_Used_Operations); - pragma Inline (Set_Variant_Part); - pragma Inline (Set_Variants); - pragma Inline (Set_Visible_Declarations); - pragma Inline (Set_Was_Attribute_Reference); - pragma Inline (Set_Was_Default_Init_Box_Association); - pragma Inline (Set_Was_Expression_Function); - pragma Inline (Set_Was_Originally_Stub); + -- Some comments from Sinfo need to be preserved???? end Sinfo; diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index b0bbf495915..6529e175faa 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -26,7 +26,9 @@ with Alloc; with Atree; use Atree; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Fname; use Fname; with Lib; use Lib; @@ -39,7 +41,8 @@ with Scans; use Scans; with Scn; use Scn; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Snames; use Snames; with System; use System; diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 3a15530f7e8..0041f0438af 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -31,6 +31,8 @@ with Debug; use Debug; with Opt; use Opt; with Output; use Output; with Scans; use Scans; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Widechar; use Widechar; with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 213b6317106..3e8348d0c17 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -28,7 +28,9 @@ with Atree; use Atree; with Casing; use Casing; with Csets; use Csets; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; @@ -37,7 +39,9 @@ with Output; use Output; with Rtsfind; use Rtsfind; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Sinput.D; use Sinput.D; with Snames; use Snames; diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb index 07926eb9ddc..8b926deb77a 100644 --- a/gcc/ada/style.adb +++ b/gcc/ada/style.adb @@ -26,12 +26,16 @@ with Atree; use Atree; with Casing; use Casing; with Csets; use Csets; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; with Stand; use Stand; with Stylesw; use Stylesw; diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb index a5f9e5cafad..4d0fd541b89 100644 --- a/gcc/ada/styleg.adb +++ b/gcc/ada/styleg.adb @@ -30,11 +30,13 @@ with Atree; use Atree; with Casing; use Casing; with Csets; use Csets; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Utils; use Einfo.Utils; with Err_Vars; use Err_Vars; with Opt; use Opt; with Scans; use Scans; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Sinput; use Sinput; with Stylesw; use Stylesw; diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 76a41ee1f5d..31e6dee435e 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -26,7 +26,9 @@ with Atree; use Atree; with Aspects; use Aspects; with Csets; use Csets; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Lib; use Lib; with Nlists; use Nlists; @@ -35,6 +37,7 @@ with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; with Sem_Aux; use Sem_Aux; +with Sinfo.Utils; use Sinfo.Utils; with Sem_Util; use Sem_Util; with Snames; use Snames; with Stand; use Stand; diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads index 3f4dafc341a..e19e2fb4311 100644 --- a/gcc/ada/tbuild.ads +++ b/gcc/ada/tbuild.ads @@ -28,6 +28,7 @@ with Namet; use Namet; with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; with Types; use Types; with Uintp; use Uintp; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 6ecea3f4088..44ac8d0283c 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -27,32 +27,31 @@ with Aspects; use Aspects; with Atree; use Atree; with Csets; use Csets; with Debug; use Debug; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; with Output; use Output; -with Sem_Mech; use Sem_Mech; -with Sinfo; use Sinfo; +with Seinfo; use Seinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Snames; use Snames; with Sinput; use Sinput; with Stand; use Stand; with Stringt; use Stringt; with SCIL_LL; use SCIL_LL; -with Treeprs; use Treeprs; with Uintp; use Uintp; with Urealp; use Urealp; with Uname; use Uname; +with Unchecked_Conversion; with Unchecked_Deallocation; package body Treepr is - use Atree.Unchecked_Access; - -- This module uses the unchecked access functions in package Atree - -- since it does an untyped traversal of the tree (we do not want to - -- count on the structure of the tree being correct in this routine). - ---------------------------------- -- Approach Used for Tree Print -- ---------------------------------- @@ -77,6 +76,10 @@ package body Treepr is -- Global Variables -- ---------------------- + Include_Low_Level : Boolean := False with Warnings => Off; + -- Set True to print low-level information useful for debugging Atree and + -- the like. + type Hash_Record is record Serial : Nat; -- Serial number for hash table entry. A value of zero means that @@ -120,10 +123,18 @@ package body Treepr is -- Local Procedures -- ---------------------- - procedure Print_End_Span (N : Node_Id); - -- Special routine to print contents of End_Span field of node N. - -- The format includes the implicit source location as well as the - -- value of the field. + function From_Union is new Unchecked_Conversion (Union_Id, Uint); + function From_Union is new Unchecked_Conversion (Union_Id, Ureal); + + -- Print_End_Span is gone. Should be restored???? + + function Capitalize (S : String) return String; + procedure Capitalize (S : in out String); + -- Turns an identifier into Mixed_Case + + function Image (F : Node_Field) return String; + + function Image (F : Entity_Field) return String; procedure Print_Init; -- Initialize for printing of tree with descendants @@ -172,9 +183,30 @@ package body Treepr is -- extension, using routines in Einfo to get the field names and flags. procedure Print_Field (Val : Union_Id; Format : UI_Format := Auto); + procedure Print_Field + (Prefix : String; + Field : String; + N : Node_Or_Entity_Id; + FD : Field_Descriptor; + Format : UI_Format); -- Print representation of Field value (name, tree, string, uint, charcode) -- The format parameter controls the format of printing in the case of an - -- integer value (see UI_Write for details). + -- integer value (see UI_Write for details).???? + -- Do we really need two of these??? + + procedure Print_Node_Field + (Prefix : String; + Field : Node_Field; + N : Node_Id; + FD : Field_Descriptor; + Format : UI_Format := Auto); + + procedure Print_Entity_Field + (Prefix : String; + Field : Entity_Field; + N : Entity_Id; + FD : Field_Descriptor; + Format : UI_Format := Auto); procedure Print_Flag (F : Boolean); -- Print True or False @@ -215,6 +247,149 @@ package body Treepr is -- descendants are to be printed. Prefix_Str is to be added to all -- printed lines. + ---------------- + -- Capitalize -- + ---------------- + + procedure Capitalize (S : in out String) is + Cap : Boolean := True; + begin + for J in S'Range loop + declare + Old : constant Character := S (J); + begin + if Cap then + S (J) := Fold_Upper (S (J)); + else + S (J) := Fold_Lower (S (J)); + end if; + + Cap := Old = '_'; + end; + end loop; + end Capitalize; + + function Capitalize (S : String) return String is + begin + return Result : String (S'Range) := S do + Capitalize (Result); + end return; + end Capitalize; + + ----------- + -- Image -- + ----------- + + function Image (F : Node_Field) return String is + begin + case F is + when Alloc_For_BIP_Return => + return "Alloc_For_BIP_Return"; + when Assignment_OK => + return "Assignment_OK"; + when Backwards_OK => + return "Backwards_OK"; + when Conversion_OK => + return "Conversion_OK"; + when Forwards_OK => + return "Forwards_OK"; + when Has_SP_Choice => + return "Has_SP_Choice"; + when Is_Elaboration_Checks_OK_Node => + return "Is_Elaboration_Checks_OK_Node"; + when Is_Elaboration_Warnings_OK_Node => + return "Is_Elaboration_Warnings_OK_Node"; + when Is_Known_Guaranteed_ABE => + return "Is_Known_Guaranteed_ABE"; + when Is_SPARK_Mode_On_Node => + return "Is_SPARK_Mode_On_Node"; + when Local_Raise_Not_OK => + return "Local_Raise_Not_OK"; + when SCIL_Controlling_Tag => + return "SCIL_Controlling_Tag"; + when SCIL_Entity => + return "SCIL_Entity"; + when SCIL_Tag_Value => + return "SCIL_Tag_Value"; + when SCIL_Target_Prim => + return "SCIL_Target_Prim"; + when Shift_Count_OK => + return "Shift_Count_OK"; + when Split_PPC => + return "Split_PPC"; + when TSS_Elist => + return "TSS_Elist"; + + when others => + return Capitalize (F'Img); + end case; + end Image; + + function Image (F : Entity_Field) return String is + begin + case F is + when BIP_Initialization_Call => + return "BIP_Initialization_Call"; + when Body_Needed_For_SAL => + return "Body_Needed_For_SAL"; + when CR_Discriminant => + return "CR_Discriminant"; + when DT_Entry_Count => + return "DT_Entry_Count"; + when DT_Offset_To_Top_Func => + return "DT_Offset_To_Top_Func"; + when DT_Position => + return "DT_Position"; + when DTC_Entity => + return "DTC_Entity"; + when Has_Inherited_DIC => + return "Has_Inherited_DIC"; + when Has_Own_DIC => + return "Has_Own_DIC"; + when Has_RACW => + return "Has_RACW"; + when Ignore_SPARK_Mode_Pragmas => + return "Ignore_SPARK_Mode_Pragmas"; + when Is_Constr_Subt_For_UN_Aliased => + return "Is_Constr_Subt_For_UN_Aliased"; + when Is_CPP_Class => + return "Is_CPP_Class"; + when Is_CUDA_Kernel => + return "Is_CUDA_Kernel"; + when Is_DIC_Procedure => + return "Is_DIC_Procedure"; + when Is_Discrim_SO_Function => + return "Is_Discrim_SO_Function"; + when Is_Elaboration_Checks_OK_Id => + return "Is_Elaboration_Checks_OK_Id"; + when Is_Elaboration_Warnings_OK_Id => + return "Is_Elaboration_Warnings_OK_Id"; + when Is_RACW_Stub_Type => + return "Is_RACW_Stub_Type"; + when OK_To_Rename => + return "OK_To_Rename"; + when Referenced_As_LHS => + return "Referenced_As_LHS"; + when RM_Size => + return "RM_Size"; + when SPARK_Aux_Pragma => + return "SPARK_Aux_Pragma"; + when SPARK_Aux_Pragma_Inherited => + return "SPARK_Aux_Pragma_Inherited"; + when SPARK_Pragma => + return "SPARK_Pragma"; + when SPARK_Pragma_Inherited => + return "SPARK_Pragma_Inherited"; + when SSO_Set_High_By_Default => + return "SSO_Set_High_By_Default"; + when SSO_Set_Low_By_Default => + return "SSO_Set_Low_By_Default"; + + when others => + return Capitalize (F'Img); + end case; + end Image; + ------- -- p -- ------- @@ -415,45 +590,11 @@ package body Treepr is Print_Term; end Print_Elist_Subtree; - -------------------- - -- Print_End_Span -- - -------------------- - - procedure Print_End_Span (N : Node_Id) is - Val : constant Uint := End_Span (N); - - begin - UI_Write (Val); - Write_Str (" (Uint = "); - Write_Int (Int (Field5 (N))); - Write_Str (") "); - - if Val /= No_Uint then - Write_Location (End_Location (N)); - end if; - end Print_End_Span; - ----------------------- -- Print_Entity_Info -- ----------------------- procedure Print_Entity_Info (Ent : Entity_Id; Prefix : String) is - function Field_Present (U : Union_Id) return Boolean; - -- Returns False unless the value U represents a missing value - -- (Empty, No_Elist, No_Uint, No_Ureal or No_String) - - function Field_Present (U : Union_Id) return Boolean is - begin - return - U /= Union_Id (Empty) and then - U /= Union_Id (No_Elist) and then - U /= To_Union (No_Uint) and then - U /= To_Union (No_Ureal) and then - U /= Union_Id (No_String); - end Field_Present; - - -- Start of processing for Print_Entity_Info - begin Print_Str (Prefix); Print_Str ("Ekind = "); @@ -480,340 +621,98 @@ package body Treepr is end; end if; - if Field_Present (Field6 (Ent)) then - Print_Str (Prefix); - Write_Field6_Name (Ent); - Write_Str (" = "); - Print_Field (Field6 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field7 (Ent)) then - Print_Str (Prefix); - Write_Field7_Name (Ent); - Write_Str (" = "); - Print_Field (Field7 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field8 (Ent)) then - Print_Str (Prefix); - Write_Field8_Name (Ent); - Write_Str (" = "); - Print_Field (Field8 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field9 (Ent)) then - Print_Str (Prefix); - Write_Field9_Name (Ent); - Write_Str (" = "); - Print_Field (Field9 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field10 (Ent)) then - Print_Str (Prefix); - Write_Field10_Name (Ent); - Write_Str (" = "); - Print_Field (Field10 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field11 (Ent)) then - Print_Str (Prefix); - Write_Field11_Name (Ent); - Write_Str (" = "); - Print_Field (Field11 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field12 (Ent)) then - Print_Str (Prefix); - Write_Field12_Name (Ent); - Write_Str (" = "); - Print_Field (Field12 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field13 (Ent)) then - Print_Str (Prefix); - Write_Field13_Name (Ent); - Write_Str (" = "); - Print_Field (Field13 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field14 (Ent)) then - Print_Str (Prefix); - Write_Field14_Name (Ent); - Write_Str (" = "); - Print_Field (Field14 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field15 (Ent)) then - Print_Str (Prefix); - Write_Field15_Name (Ent); - Write_Str (" = "); - Print_Field (Field15 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field16 (Ent)) then - Print_Str (Prefix); - Write_Field16_Name (Ent); - Write_Str (" = "); - Print_Field (Field16 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field17 (Ent)) then - Print_Str (Prefix); - Write_Field17_Name (Ent); - Write_Str (" = "); - Print_Field (Field17 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field18 (Ent)) then - Print_Str (Prefix); - Write_Field18_Name (Ent); - Write_Str (" = "); - Print_Field (Field18 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field19 (Ent)) then - Print_Str (Prefix); - Write_Field19_Name (Ent); - Write_Str (" = "); - Print_Field (Field19 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field20 (Ent)) then - Print_Str (Prefix); - Write_Field20_Name (Ent); - Write_Str (" = "); - Print_Field (Field20 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field21 (Ent)) then - Print_Str (Prefix); - Write_Field21_Name (Ent); - Write_Str (" = "); - Print_Field (Field21 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field22 (Ent)) then - Print_Str (Prefix); - Write_Field22_Name (Ent); - Write_Str (" = "); - - -- Mechanism case has to be handled specially - - if Ekind (Ent) = E_Function or else Is_Formal (Ent) then - declare - M : constant Mechanism_Type := Mechanism (Ent); - - begin - case M is - when Default_Mechanism => - Write_Str ("Default"); - - when By_Copy => - Write_Str ("By_Copy"); - - when By_Reference => - Write_Str ("By_Reference"); - - when 1 .. Mechanism_Type'Last => - Write_Str ("By_Copy if size <= "); - Write_Int (Int (M)); - end case; - end; - - -- Normal case (not Mechanism) - - else - Print_Field (Field22 (Ent)); - end if; - - Print_Eol; - end if; - - if Field_Present (Field23 (Ent)) then - Print_Str (Prefix); - Write_Field23_Name (Ent); - Write_Str (" = "); - Print_Field (Field23 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field24 (Ent)) then - Print_Str (Prefix); - Write_Field24_Name (Ent); - Write_Str (" = "); - Print_Field (Field24 (Ent)); - Print_Eol; - end if; - - if Field_Present (Field25 (Ent)) then - Print_Str (Prefix); - Write_Field25_Name (Ent); - Write_Str (" = "); - Print_Field (Field25 (Ent)); - Print_Eol; - end if; + declare + A : Entity_Field_Array renames Entity_Field_Table (Ekind (Ent)).all; + Already_Printed_Above : constant Entity_Field_Set := + (Ekind + | Basic_Convention => True, -- Convention was printed + others => False); + begin + -- Outer loop makes flags come out last + + for Print_Flags in Boolean loop + for Field_Index in A'Range loop + declare + FD : Field_Descriptor renames + Entity_Field_Descriptors (A (Field_Index)); + begin + if Already_Printed_Above (A (Field_Index)) then + null; -- Skip the ones already printed + + elsif (FD.Kind = Flag_Field) = Print_Flags then + Print_Entity_Field + (Prefix, A (Field_Index), Ent, FD); + end if; + end; + end loop; + end loop; + end; + end Print_Entity_Info; - if Field_Present (Field26 (Ent)) then - Print_Str (Prefix); - Write_Field26_Name (Ent); - Write_Str (" = "); - Print_Field (Field26 (Ent)); - Print_Eol; - end if; + --------------- + -- Print_Eol -- + --------------- - if Field_Present (Field27 (Ent)) then - Print_Str (Prefix); - Write_Field27_Name (Ent); - Write_Str (" = "); - Print_Field (Field27 (Ent)); - Print_Eol; + procedure Print_Eol is + begin + if Phase = Printing then + Write_Eol; end if; + end Print_Eol; - if Field_Present (Field28 (Ent)) then - Print_Str (Prefix); - Write_Field28_Name (Ent); - Write_Str (" = "); - Print_Field (Field28 (Ent)); - Print_Eol; - end if; + ----------------- + -- Print_Field -- + ----------------- - if Field_Present (Field29 (Ent)) then - Print_Str (Prefix); - Write_Field29_Name (Ent); - Write_Str (" = "); - Print_Field (Field29 (Ent)); - Print_Eol; - end if; + -- Instantiations of low-level getters and setters that take offsets + -- in units of the size of the field. - if Field_Present (Field30 (Ent)) then - Print_Str (Prefix); - Write_Field30_Name (Ent); - Write_Str (" = "); - Print_Field (Field30 (Ent)); - Print_Eol; - end if; + use Atree.Atree_Private_Part; - if Field_Present (Field31 (Ent)) then - Print_Str (Prefix); - Write_Field31_Name (Ent); - Write_Str (" = "); - Print_Field (Field31 (Ent)); - Print_Eol; - end if; + function Get_Flag is new Get_1_Bit_Field + (Boolean) with Inline; - if Field_Present (Field32 (Ent)) then - Print_Str (Prefix); - Write_Field32_Name (Ent); - Write_Str (" = "); - Print_Field (Field32 (Ent)); - Print_Eol; - end if; + function Get_Node_Id is new Get_32_Bit_Field + (Node_Id) with Inline; - if Field_Present (Field33 (Ent)) then - Print_Str (Prefix); - Write_Field33_Name (Ent); - Write_Str (" = "); - Print_Field (Field33 (Ent)); - Print_Eol; - end if; + function Get_List_Id is new Get_32_Bit_Field + (List_Id) with Inline; - if Field_Present (Field34 (Ent)) then - Print_Str (Prefix); - Write_Field34_Name (Ent); - Write_Str (" = "); - Print_Field (Field34 (Ent)); - Print_Eol; - end if; + function Get_Elist_Id is new Get_32_Bit_Field_With_Default + (Elist_Id, No_Elist) with Inline; - if Field_Present (Field35 (Ent)) then - Print_Str (Prefix); - Write_Field35_Name (Ent); - Write_Str (" = "); - Print_Field (Field35 (Ent)); - Print_Eol; - end if; + function Get_Name_Id is new Get_32_Bit_Field + (Name_Id) with Inline; - if Field_Present (Field36 (Ent)) then - Print_Str (Prefix); - Write_Field36_Name (Ent); - Write_Str (" = "); - Print_Field (Field36 (Ent)); - Print_Eol; - end if; + function Get_String_Id is new Get_32_Bit_Field + (String_Id) with Inline; - if Field_Present (Field37 (Ent)) then - Print_Str (Prefix); - Write_Field37_Name (Ent); - Write_Str (" = "); - Print_Field (Field37 (Ent)); - Print_Eol; - end if; + function Get_Uint is new Get_32_Bit_Field_With_Default + (Uint, Uint_0) with Inline; - if Field_Present (Field38 (Ent)) then - Print_Str (Prefix); - Write_Field38_Name (Ent); - Write_Str (" = "); - Print_Field (Field38 (Ent)); - Print_Eol; - end if; + function Get_Ureal is new Get_32_Bit_Field + (Ureal) with Inline; - if Field_Present (Field39 (Ent)) then - Print_Str (Prefix); - Write_Field39_Name (Ent); - Write_Str (" = "); - Print_Field (Field39 (Ent)); - Print_Eol; - end if; + function Get_Nkind_Type is new Get_8_Bit_Field + (Node_Kind) with Inline; - if Field_Present (Field40 (Ent)) then - Print_Str (Prefix); - Write_Field40_Name (Ent); - Write_Str (" = "); - Print_Field (Field40 (Ent)); - Print_Eol; - end if; + function Get_Ekind_Type is new Get_8_Bit_Field + (Entity_Kind) with Inline; - if Field_Present (Field41 (Ent)) then - Print_Str (Prefix); - Write_Field41_Name (Ent); - Write_Str (" = "); - Print_Field (Field41 (Ent)); - Print_Eol; - end if; + function Get_Source_Ptr is new Get_32_Bit_Field + (Source_Ptr) with Inline, Unreferenced; - Write_Entity_Flags (Ent, Prefix); - end Print_Entity_Info; + function Get_Small_Paren_Count_Type is new Get_2_Bit_Field + (Small_Paren_Count_Type) with Inline, Unreferenced; - --------------- - -- Print_Eol -- - --------------- + function Get_Union_Id is new Get_32_Bit_Field + (Union_Id) with Inline; - procedure Print_Eol is - begin - if Phase = Printing then - Write_Eol; - end if; - end Print_Eol; + function Get_Convention_Id is new Get_8_Bit_Field + (Convention_Id) with Inline, Unreferenced; - ----------------- - -- Print_Field -- - ----------------- + function Get_Mechanism_Type is new Get_32_Bit_Field + (Mechanism_Type) with Inline, Unreferenced; procedure Print_Field (Val : Union_Id; Format : UI_Format := Auto) is begin @@ -860,6 +759,236 @@ package body Treepr is end if; end Print_Field; + procedure Print_Field + (Prefix : String; + Field : String; + N : Node_Or_Entity_Id; + FD : Field_Descriptor; + Format : UI_Format) is + + Printed : Boolean := False; + + procedure Print_Initial; + -- Print the initial stuff that goes before the value + + procedure Print_Initial is + begin + Printed := True; + Print_Str (Prefix); + Print_Str (Field); + + if Include_Low_Level then + Write_Str (" at "); + Write_Int (Int (FD.Offset)); + end if; + + Write_Str (" = "); + end Print_Initial; + + begin + if Phase /= Printing then + return; + end if; + + case FD.Kind is + when Flag_Field => + declare + Val : constant Boolean := Get_Flag (N, FD.Offset); + begin + if Val then + Print_Initial; + Print_Flag (Val); + end if; + end; + + when Node_Id_Field => + declare + Val : constant Node_Id := Get_Node_Id (N, FD.Offset); + begin + if Present (Val) then + Print_Initial; + Print_Node_Ref (Val); + end if; + end; + + when List_Id_Field => + declare + Val : constant List_Id := Get_List_Id (N, FD.Offset); + begin + if Present (Val) then + Print_Initial; + Print_List_Ref (Val); + end if; + end; + + when Elist_Id_Field => + declare + Val : constant Elist_Id := Get_Elist_Id (N, FD.Offset); + begin + if Present (Val) then + Print_Initial; + Print_Elist_Ref (Val); + end if; + end; + + when Name_Id_Field => + declare + Val : constant Name_Id := Get_Name_Id (N, FD.Offset); + begin + if Present (Val) then + Print_Initial; + Print_Name (Val); + Write_Str (" (Name_Id="); + Write_Int (Int (Val)); + Write_Char (')'); + end if; + end; + + when String_Id_Field => + declare + Val : constant String_Id := Get_String_Id (N, FD.Offset); + begin + if Val /= No_String then + Print_Initial; + Write_String_Table_Entry (Val); + Write_Str (" (String_Id="); + Write_Int (Int (Val)); + Write_Char (')'); + end if; + end; + + when Uint_Field => + declare + Val : constant Uint := Get_Uint (N, FD.Offset); + function Cast is new Unchecked_Conversion (Uint, Int); + begin + if Val /= No_Uint then + Print_Initial; + UI_Write (Val, Format); + Write_Str (" (Uint = "); + Write_Int (Cast (Val)); + Write_Char (')'); + end if; + end; + + when Ureal_Field => + declare + Val : constant Ureal := Get_Ureal (N, FD.Offset); + function Cast is new Unchecked_Conversion (Ureal, Int); + begin + if Val /= No_Ureal then + Print_Initial; + UR_Write (Val); + Write_Str (" (Ureal = "); + Write_Int (Cast (Val)); + Write_Char (')'); + end if; + end; + + when Nkind_Type_Field => + declare + Val : constant Node_Kind := Get_Nkind_Type (N, FD.Offset); + begin + Print_Initial; + Print_Str_Mixed_Case (Node_Kind'Image (Val)); + end; + + when Ekind_Type_Field => + declare + Val : constant Entity_Kind := Get_Ekind_Type (N, FD.Offset); + begin + Print_Initial; + Print_Str_Mixed_Case (Entity_Kind'Image (Val)); + end; + + pragma Style_Checks ("M200"); + + when Union_Id_Field => + declare + Val : constant Union_Id := Get_Union_Id (N, FD.Offset); + begin + if Val /= Empty_List_Or_Node then + Print_Initial; + + if Val in Node_Range then + Print_Node_Ref (Node_Id (Val)); + + elsif Val in List_Range then + Print_List_Ref (List_Id (Val)); + + else + Print_Str ("????union id out of range"); + end if; + end if; + end; + pragma Style_Checks ("M79"); + + when others => + Print_Initial; + Print_Str ("????"); + end case; + + if Printed then + Print_Eol; + end if; + + exception + when others => + declare + function Cast is new Unchecked_Conversion (Field_32_Bit, Int); + begin + Write_Eol; + Print_Initial; + Write_Str ("exception raised in Print_Field -- int val = "); + Write_Eol; + + case Field_Size (FD.Kind) is + when 1 => Write_Int (Int (Get_1_Bit_Val (N, FD.Offset))); + when 2 => Write_Int (Int (Get_2_Bit_Val (N, FD.Offset))); + when 4 => Write_Int (Int (Get_4_Bit_Val (N, FD.Offset))); + when 8 => Write_Int (Int (Get_8_Bit_Val (N, FD.Offset))); + when others => -- 32 + Write_Int (Cast (Get_32_Bit_Val (N, FD.Offset))); + end case; + + Write_Str (", "); + Write_Str (FD.Kind'Img); + Write_Str (" "); + Write_Int (Int (Field_Size (FD.Kind))); + Write_Str (" bits"); + Write_Eol; + exception + when others => + Write_Eol; + Write_Str ("double exception raised in Print_Field"); + Write_Eol; + end; + end Print_Field; + + procedure Print_Node_Field + (Prefix : String; + Field : Node_Field; + N : Node_Id; + FD : Field_Descriptor; + Format : UI_Format := Auto) is + begin + if not Field_Is_Initial_Zero (N, Field) then + Print_Field (Prefix, Image (Field), N, FD, Format); + end if; + end Print_Node_Field; + + procedure Print_Entity_Field + (Prefix : String; + Field : Entity_Field; + N : Entity_Id; + FD : Field_Descriptor; + Format : UI_Format := Auto) is + begin + if not Field_Is_Initial_Zero (N, Field) then + Print_Field (Prefix, Image (Field), N, FD, Format); + end if; + end Print_Entity_Field; + ---------------- -- Print_Flag -- ---------------- @@ -993,11 +1122,7 @@ package body Treepr is Prefix_Str : String; Prefix_Char : Character) is - F : Fchar; - P : Natural; - - Field_To_Be_Printed : Boolean; - Prefix_Str_Char : String (Prefix_Str'First .. Prefix_Str'Last + 1); + Prefix : constant String := Prefix_Str & Prefix_Char; Sfile : Source_File_Index; Fmt : UI_Format; @@ -1010,25 +1135,13 @@ package body Treepr is -- If there is no such node, indicate that. Skip the rest, so we don't -- crash getting fields of the nonexistent node. - if N > Atree_Private_Part.Nodes.Last then + if not Is_Valid_Node (Union_Id (N)) then Print_Str ("No such node: "); Print_Int (Int (N)); Print_Eol; return; end if; - -- Similarly, if N points to an extension, avoid crashing - - if Atree_Private_Part.Nodes.Table (N).Is_Extension then - Print_Int (Int (N)); - Print_Str (" is an extension, not a node"); - Print_Eol; - return; - end if; - - Prefix_Str_Char (Prefix_Str'Range) := Prefix_Str; - Prefix_Str_Char (Prefix_Str'Last + 1) := Prefix_Char; - -- Print header line Print_Str (Prefix_Str); @@ -1041,6 +1154,10 @@ package body Treepr is Print_Eol; end if; + if Include_Low_Level then + Print_Atree_Info (N); + end if; + if N = Empty then return; end if; @@ -1055,7 +1172,7 @@ package body Treepr is -- Print Sloc field if it is set if Sloc (N) /= No_Location then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Sloc = "); if Sloc (N) = Standard_Location then @@ -1077,7 +1194,7 @@ package body Treepr is -- Print Chars field if present if Nkind (N) in N_Has_Chars and then Chars (N) /= No_Name then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Chars = "); Print_Name (Chars (N)); Write_Str (" (Name_Id="); @@ -1099,7 +1216,7 @@ package body Treepr is -- Print Left_Opnd if present if Nkind (N) not in N_Unary_Op then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Left_Opnd = "); Print_Node_Ref (Left_Opnd (N)); Print_Eol; @@ -1107,7 +1224,7 @@ package body Treepr is -- Print Right_Opnd - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Right_Opnd = "); Print_Node_Ref (Right_Opnd (N)); Print_Eol; @@ -1117,7 +1234,7 @@ package body Treepr is -- are in the table, so are handled in the normal circuit) if Nkind (N) in N_Op and then Present (Entity (N)) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Entity = "); Print_Node_Ref (Entity (N)); Print_Eol; @@ -1128,62 +1245,62 @@ package body Treepr is if Nkind (N) in N_Subexpr then if Assignment_OK (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Assignment_OK = True"); Print_Eol; end if; if Do_Range_Check (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Do_Range_Check = True"); Print_Eol; end if; if Has_Dynamic_Length_Check (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Has_Dynamic_Length_Check = True"); Print_Eol; end if; if Has_Aspects (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Has_Aspects = True"); Print_Eol; end if; if Is_Controlling_Actual (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Is_Controlling_Actual = True"); Print_Eol; end if; if Is_Overloaded (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Is_Overloaded = True"); Print_Eol; end if; if Is_Static_Expression (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Is_Static_Expression = True"); Print_Eol; end if; if Must_Not_Freeze (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Must_Not_Freeze = True"); Print_Eol; end if; if Paren_Count (N) /= 0 then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Paren_Count = "); Print_Int (Int (Paren_Count (N))); Print_Eol; end if; if Raises_Constraint_Error (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Raises_Constraint_Error = True"); Print_Eol; end if; @@ -1193,7 +1310,7 @@ package body Treepr is -- Print Do_Overflow_Check field if present if Nkind (N) in N_Op and then Do_Overflow_Check (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Do_Overflow_Check = True"); Print_Eol; end if; @@ -1202,16 +1319,14 @@ package body Treepr is -- is handled by the Print_Entity_Info procedure). if Nkind (N) in N_Has_Etype and then Present (Etype (N)) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Etype = "); Print_Node_Ref (Etype (N)); Print_Eol; end if; end if; - - -- Loop to print fields included in Pchars array - - P := Pchar_Pos (Nkind (N)); + -- ????Can some of the above be handled by the + -- loop below, or by calling Print_Field directly? if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) then Fmt := Hex; @@ -1219,115 +1334,62 @@ package body Treepr is Fmt := Auto; end if; - while P < Pchar_Pos (Node_Kind'Succ (Nkind (N))) loop - F := Pchars (P); - P := P + 1; - - -- Check for case of False flag, which we never print, or an Empty - -- field, which is also never printed. - - case F is - when F_Field1 => - Field_To_Be_Printed := Field1 (N) /= Union_Id (Empty); - - when F_Field2 => - Field_To_Be_Printed := Field2 (N) /= Union_Id (Empty); - - when F_Field3 => - Field_To_Be_Printed := Field3 (N) /= Union_Id (Empty); - - when F_Field4 => - Field_To_Be_Printed := Field4 (N) /= Union_Id (Empty); - - when F_Field5 => - Field_To_Be_Printed := Field5 (N) /= Union_Id (Empty); - - when F_Flag1 => Field_To_Be_Printed := Flag1 (N); - when F_Flag2 => Field_To_Be_Printed := Flag2 (N); - when F_Flag3 => Field_To_Be_Printed := Flag3 (N); - when F_Flag4 => Field_To_Be_Printed := Flag4 (N); - when F_Flag5 => Field_To_Be_Printed := Flag5 (N); - when F_Flag6 => Field_To_Be_Printed := Flag6 (N); - when F_Flag7 => Field_To_Be_Printed := Flag7 (N); - when F_Flag8 => Field_To_Be_Printed := Flag8 (N); - when F_Flag9 => Field_To_Be_Printed := Flag9 (N); - when F_Flag10 => Field_To_Be_Printed := Flag10 (N); - when F_Flag11 => Field_To_Be_Printed := Flag11 (N); - when F_Flag12 => Field_To_Be_Printed := Flag12 (N); - when F_Flag13 => Field_To_Be_Printed := Flag13 (N); - when F_Flag14 => Field_To_Be_Printed := Flag14 (N); - when F_Flag15 => Field_To_Be_Printed := Flag15 (N); - when F_Flag16 => Field_To_Be_Printed := Flag16 (N); - when F_Flag17 => Field_To_Be_Printed := Flag17 (N); - when F_Flag18 => Field_To_Be_Printed := Flag18 (N); - end case; - - -- Print field if it is to be printed - - if Field_To_Be_Printed then - Print_Str (Prefix_Str_Char); - - while P < Pchar_Pos (Node_Kind'Succ (Nkind (N))) - and then Pchars (P) not in Fchar - loop - Print_Char (Pchars (P)); - P := P + 1; - end loop; - - Print_Str (" = "); - - case F is - when F_Field1 => Print_Field (Field1 (N), Fmt); - when F_Field2 => Print_Field (Field2 (N), Fmt); - when F_Field3 => Print_Field (Field3 (N), Fmt); - when F_Field4 => Print_Field (Field4 (N), Fmt); - - -- Special case End_Span = Uint5 - - when F_Field5 => - if Nkind (N) in N_Case_Statement | N_If_Statement then - Print_End_Span (N); - else - Print_Field (Field5 (N), Fmt); + declare + A : Node_Field_Array renames Node_Field_Table (Nkind (N)).all; + Already_Printed_Above : constant Node_Field_Set := + (Nkind + | Chars + | Comes_From_Source + | Analyzed + | Error_Posted + | Is_Ignored_Ghost_Node + | Check_Actuals + | Link -- Parent was printed + | Sloc + | Left_Opnd + | Right_Opnd + | Entity + | Assignment_OK + | Do_Range_Check + | Has_Dynamic_Length_Check + | Has_Aspects + | Is_Controlling_Actual + | Is_Overloaded + | Is_Static_Expression + | Must_Not_Freeze + | Small_Paren_Count -- Paren_Count was printed + | Raises_Constraint_Error + | Do_Overflow_Check + | Etype + | In_List -- ????wasn't printed by old version + => True, + + others => False); + begin + -- Outer loop makes flags come out last + + for Print_Flags in Boolean loop + for Field_Index in A'Range loop -- Use Walk_Sinfo_Fields???? + declare + FD : Field_Descriptor renames + Node_Field_Descriptors (A (Field_Index)); + begin + if Already_Printed_Above (A (Field_Index)) then + null; -- Skip the ones already printed + + elsif (FD.Kind = Flag_Field) = Print_Flags then + Print_Node_Field + (Prefix, A (Field_Index), N, FD, Fmt); end if; - - when F_Flag1 => Print_Flag (Flag1 (N)); - when F_Flag2 => Print_Flag (Flag2 (N)); - when F_Flag3 => Print_Flag (Flag3 (N)); - when F_Flag4 => Print_Flag (Flag4 (N)); - when F_Flag5 => Print_Flag (Flag5 (N)); - when F_Flag6 => Print_Flag (Flag6 (N)); - when F_Flag7 => Print_Flag (Flag7 (N)); - when F_Flag8 => Print_Flag (Flag8 (N)); - when F_Flag9 => Print_Flag (Flag9 (N)); - when F_Flag10 => Print_Flag (Flag10 (N)); - when F_Flag11 => Print_Flag (Flag11 (N)); - when F_Flag12 => Print_Flag (Flag12 (N)); - when F_Flag13 => Print_Flag (Flag13 (N)); - when F_Flag14 => Print_Flag (Flag14 (N)); - when F_Flag15 => Print_Flag (Flag15 (N)); - when F_Flag16 => Print_Flag (Flag16 (N)); - when F_Flag17 => Print_Flag (Flag17 (N)); - when F_Flag18 => Print_Flag (Flag18 (N)); - end case; - - Print_Eol; - - -- Field is not to be printed (False flag field) - - else - while P < Pchar_Pos (Node_Kind'Succ (Nkind (N))) - and then Pchars (P) not in Fchar - loop - P := P + 1; + end; end loop; - end if; - end loop; + end loop; + end; -- Print aspects if present if Has_Aspects (N) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("Aspect_Specifications = "); Print_Field (Union_Id (Aspect_Specifications (N))); Print_Eol; @@ -1336,13 +1398,13 @@ package body Treepr is -- Print entity information for entities if Nkind (N) in N_Entity then - Print_Entity_Info (N, Prefix_Str_Char); + Print_Entity_Info (N, Prefix); end if; -- Print the SCIL node (if available) if Present (Get_SCIL_Node (N)) then - Print_Str (Prefix_Str_Char); + Print_Str (Prefix); Print_Str ("SCIL_Node = "); Print_Node_Ref (Get_SCIL_Node (N)); Print_Eol; @@ -1393,7 +1455,7 @@ package body Treepr is begin Print_Node_Ref (N); - if N > Atree_Private_Part.Nodes.Last then + if not Is_Valid_Node (Union_Id (N)) then Print_Str (" (no such node)"); Print_Eol; return; @@ -1442,6 +1504,8 @@ package body Treepr is -- Note: the call to Fold_Upper in this loop is to get past the GNAT -- bug of 'Image returning lower case instead of upper case. + -- ????I'm sure that bug has long been fixed. This code was written + -- in 2001. It should call Print_Str_Mixed_Case? for J in S'Range loop if Ucase then @@ -2060,13 +2124,8 @@ package body Treepr is Visit_Elist (Elist_Id (D), New_Prefix); end if; - -- For all other kinds of descendants (strings, names, uints etc), - -- there is nothing to visit (the contents of the field will be - -- printed when we print the containing node, but what concerns - -- us now is looking for descendants in the tree. - else - null; + raise Program_Error; end if; end Visit_Descendant; @@ -2129,42 +2188,49 @@ package body Treepr is -- Visit all descendants of this node - if Nkind (N) not in N_Entity then - Visit_Descendant (Field1 (N)); - Visit_Descendant (Field2 (N)); - Visit_Descendant (Field3 (N)); - Visit_Descendant (Field4 (N)); - Visit_Descendant (Field5 (N)); - - if Has_Aspects (N) then - Visit_Descendant (Union_Id (Aspect_Specifications (N))); - end if; + declare + A : Node_Field_Array renames Node_Field_Table (Nkind (N)).all; + begin + for Field_Index in A'Range loop + declare + F : constant Node_Field := A (Field_Index); + FD : Field_Descriptor renames Node_Field_Descriptors (F); + begin + if FD.Kind in Node_Id_Field | List_Id_Field | Elist_Id_Field + -- For all other kinds of descendants (strings, names, uints + -- etc), there is nothing to visit (the contents of the + -- field will be printed when we print the containing node, + -- but what concerns us now is looking for descendants in + -- the tree. + + and then F /= Next_Entity -- See below for why we skip this + then + Visit_Descendant (Get_Union_Id (N, FD.Offset)); + end if; + end; + end loop; + end; - -- Entity case + if Has_Aspects (N) then + Visit_Descendant (Union_Id (Aspect_Specifications (N))); + end if; - else - Visit_Descendant (Field1 (N)); - Visit_Descendant (Field3 (N)); - Visit_Descendant (Field4 (N)); - Visit_Descendant (Field5 (N)); - Visit_Descendant (Field6 (N)); - Visit_Descendant (Field7 (N)); - Visit_Descendant (Field8 (N)); - Visit_Descendant (Field9 (N)); - Visit_Descendant (Field10 (N)); - Visit_Descendant (Field11 (N)); - Visit_Descendant (Field12 (N)); - Visit_Descendant (Field13 (N)); - Visit_Descendant (Field14 (N)); - Visit_Descendant (Field15 (N)); - Visit_Descendant (Field16 (N)); - Visit_Descendant (Field17 (N)); - Visit_Descendant (Field18 (N)); - Visit_Descendant (Field19 (N)); - Visit_Descendant (Field20 (N)); - Visit_Descendant (Field21 (N)); - Visit_Descendant (Field22 (N)); - Visit_Descendant (Field23 (N)); + if Nkind (N) in N_Entity then + declare + A : Entity_Field_Array renames Entity_Field_Table (Ekind (N)).all; + begin + for Field_Index in A'Range loop + declare + F : constant Entity_Field := A (Field_Index); + FD : Field_Descriptor renames Entity_Field_Descriptors (F); + begin + if FD.Kind in Node_Id_Field | List_Id_Field | Elist_Id_Field + then + Visit_Descendant (Get_Union_Id (N, FD.Offset)); + end if; + end; + end loop; + end; -- Now an interesting special case. Normally parents are always -- printed since we traverse the tree in a downwards direction. @@ -2176,12 +2242,11 @@ package body Treepr is Visit_Descendant (Union_Id (Parent (N))); end if; - -- You may be wondering why we omitted Field2 above. The answer - -- is that this is the Next_Entity field, and we want to treat - -- it rather specially. Why? Because a Next_Entity link does not - -- correspond to a level deeper in the tree, and we do not want - -- the tree to march off to the right of the page due to bogus - -- indentations coming from this effect. + -- You may be wondering why we omitted Next_Entity above. The answer + -- is that we want to treat it rather specially. Why? Because a + -- Next_Entity link does not correspond to a level deeper in the + -- tree, and we do not want the tree to march off to the right of the + -- page due to bogus indentations coming from this effect. -- To prevent this, what we do is to control references via -- Next_Entity only from the first entity on a given scope chain, diff --git a/gcc/ada/treepr.ads b/gcc/ada/treepr.ads index 67af7b4414b..8c496cbca8b 100644 --- a/gcc/ada/treepr.ads +++ b/gcc/ada/treepr.ads @@ -80,7 +80,8 @@ package Treepr is pragma Export (Ada, pe); -- Print a node, node list, uint, or anything else that falls under -- the definition of Union_Id. Historically this was only for printing - -- nodes, hence the name. + -- nodes, hence the name pn. These are all the same, but the renamings + -- need to be in the body, or else the debugger can't find them. procedure ppar (N : Union_Id); pragma Export (Ada, ppar); diff --git a/gcc/ada/treeprs.adt b/gcc/ada/treeprs.adt deleted file mode 100644 index b65d6c26b58..00000000000 --- a/gcc/ada/treeprs.adt +++ /dev/null @@ -1,107 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- T R E E P R S -- --- -- --- T e m p l a t e -- --- -- --- Copyright (C) 1992-2013, 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. -- --- -- ------------------------------------------------------------------------------- --- This file is a template used as input to the utility program XTreeprs, --- which reads this template, and the spec of Sinfo (sinfo.ads) and generates --- the spec for the Treeprs package (file treeprs.ads) - --- This package contains the declaration of the string used by the Tree_Print --- package. It must be updated whenever the arrangements of the field names --- in package Sinfo is changed. The utility program XTREEPRS is used to --- do this update correctly using the template treeprs.adt as input. - -with Sinfo; use Sinfo; - -package Treeprs is - - -------------------------------- - -- String Data for Node Print -- - -------------------------------- - - -- String data for print out. The Pchars array is a long string with the - -- the entry for each node type consisting of a single blank, followed by - -- a series of entries, one for each Op or Flag field used for the node. - -- Each entry has a single character which identifies the field, followed - -- by the synonym name. The starting location for a given node type is - -- found from the corresponding entry in the Pchars_Pos_Array. - - -- The following characters identify the field. These are characters which - -- could never occur in a field name, so they also mark the end of the - -- previous name. - - -- Note the following definitions do not include Flag0. This will have to - -- be addressed if we ever need to use Flag0 (it's not currently used). - - subtype Fchar is Character range '#' .. '9'; - - F_Field1 : constant Fchar := '#'; -- Character'Val (16#23#) - F_Field2 : constant Fchar := '$'; -- Character'Val (16#24#) - F_Field3 : constant Fchar := '%'; -- Character'Val (16#25#) - F_Field4 : constant Fchar := '&'; -- Character'Val (16#26#) - F_Field5 : constant Fchar := '''; -- Character'Val (16#27#) - F_Flag1 : constant Fchar := '('; -- Character'Val (16#28#) - F_Flag2 : constant Fchar := ')'; -- Character'Val (16#29#) - F_Flag3 : constant Fchar := '*'; -- Character'Val (16#2A#) - F_Flag4 : constant Fchar := '+'; -- Character'Val (16#2B#) - F_Flag5 : constant Fchar := ','; -- Character'Val (16#2C#) - F_Flag6 : constant Fchar := '-'; -- Character'Val (16#2D#) - F_Flag7 : constant Fchar := '.'; -- Character'Val (16#2E#) - F_Flag8 : constant Fchar := '/'; -- Character'Val (16#2F#) - F_Flag9 : constant Fchar := '0'; -- Character'Val (16#30#) - F_Flag10 : constant Fchar := '1'; -- Character'Val (16#31#) - F_Flag11 : constant Fchar := '2'; -- Character'Val (16#32#) - F_Flag12 : constant Fchar := '3'; -- Character'Val (16#33#) - F_Flag13 : constant Fchar := '4'; -- Character'Val (16#34#) - F_Flag14 : constant Fchar := '5'; -- Character'Val (16#35#) - F_Flag15 : constant Fchar := '6'; -- Character'Val (16#36#) - F_Flag16 : constant Fchar := '7'; -- Character'Val (16#37#) - F_Flag17 : constant Fchar := '8'; -- Character'Val (16#38#) - F_Flag18 : constant Fchar := '9'; -- Character'Val (16#39#) - - -- Note this table does not include entity field and flags whose access - -- functions are in Einfo (these are handled by the Print_Entity_Info - -- procedure in Treepr, which uses the routines in Einfo to get the proper - -- symbolic information). In addition, the following fields are handled by - -- Treepr, and do not appear in the Pchars array: - - -- Analyzed - -- Cannot_Be_Constant - -- Chars - -- Comes_From_Source - -- Error_Posted - -- Etype - -- Is_Controlling_Actual - -- Is_Overloaded - -- Is_Static_Expression - -- Left_Opnd - -- Must_Check_Expr - -- Must_Not_Freeze - -- No_Overflow_Expr - -- Paren_Count - -- Raises_Constraint_Error - -- Right_Opnd - -!!TEMPLATE INSERTION POINT - -end Treeprs; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 17665f05fb5..f6c420acb83 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -312,8 +312,7 @@ package Types is -- The tree Id values start at zero, because we use zero for Empty (to -- allow a zero test for Empty). - Node_High_Bound : constant := - (if Standard'Address_Size = 32 then 299_999_999 else 1_999_999_999); + Node_High_Bound : constant := 1_999_999_999; Elist_Low_Bound : constant := -199_999_999; -- The Elist_Id values are subscripts into an array of elist headers which @@ -387,7 +386,7 @@ package Types is -- the special values Empty and Error are subscripts into this table. -- See package Atree for further details. - type Node_Id is range Node_Low_Bound .. Node_High_Bound; + type Node_Id is range Node_Low_Bound .. Node_High_Bound with Size => 32; -- Type used to identify nodes in the tree subtype Entity_Id is Node_Id; @@ -436,7 +435,7 @@ package Types is -- attempt to apply list operations to No_List will cause a (detected) -- error. - type List_Id is range List_Low_Bound .. List_High_Bound; + type List_Id is range List_Low_Bound .. List_High_Bound with Size => 32; -- Type used to identify a node list No_List : constant List_Id := List_High_Bound; @@ -461,7 +460,7 @@ package Types is -- of the tree, allowing nodes to be members of more than one such list -- (see package Elists for further details). - type Elist_Id is range Elist_Low_Bound .. Elist_High_Bound; + type Elist_Id is range Elist_Low_Bound .. Elist_High_Bound with Size => 32; -- Type used to identify an element list (Elist header table subscript) No_Elist : constant Elist_Id := Elist_Low_Bound; @@ -491,7 +490,8 @@ package Types is -- String_Id values are used to identify entries in the strings table. They -- are subscripts into the Strings table defined in package Stringt. - type String_Id is range Strings_Low_Bound .. Strings_High_Bound; + type String_Id is range Strings_Low_Bound .. Strings_High_Bound + with Size => 32; -- Type used to identify entries in the strings table No_String : constant String_Id := Strings_Low_Bound; @@ -817,6 +817,38 @@ package Types is -- then Default_C_Record_Mechanism is set to 32, and the meaning is to use -- By_Reference if the size is greater than 32, and By_Copy otherwise. + --------------------------------- + -- Component_Alignment Control -- + --------------------------------- + + -- There are four types of alignment possible for array and record + -- types, and a field in the type entities contains a value of the + -- following type indicating which alignment choice applies. For full + -- details of the meaning of these alignment types, see description + -- of the Component_Alignment pragma. + + type Component_Alignment_Kind is ( + Calign_Default, -- default alignment + Calign_Component_Size, -- natural alignment for component size + Calign_Component_Size_4, -- natural for size <= 4, 4 for size >= 4 + Calign_Storage_Unit); -- all components byte aligned + + ----------------------------------- + -- Floating Point Representation -- + ----------------------------------- + + type Float_Rep_Kind is ( + IEEE_Binary, -- IEEE 754p conforming binary format + AAMP); -- AAMP format + + ---------------------------- + -- Small_Paren_Count_Type -- + ---------------------------- + + -- See Paren_Count in Atree for documentation + + subtype Small_Paren_Count_Type is Nat range 0 .. 3; + ------------------------------ -- Run-Time Exception Codes -- ------------------------------ @@ -948,4 +980,21 @@ package Types is SE_Infinite_Recursion => SE_Reason, SE_Object_Too_Large => SE_Reason); + -- Types for field offsets/sizes used in Seinfo, Sinfo.Nodes and + -- Einfo.Entities: + + type Field_Offset is new Nat; + -- Offset of a node field, in units of the size of the field, which is + -- always a power of 2. + + subtype Field_Size_In_Bits is Field_Offset with Predicate => + Field_Size_In_Bits in 1 | 2 | 4 | 8 | 32; + + subtype Opt_Field_Offset is Field_Offset'Base range -1 .. Field_Offset'Last; + No_Field_Offset : constant Opt_Field_Offset := Opt_Field_Offset'First; + + type Offset_Array_Index is new Nat; + type Offset_Array is + array (Offset_Array_Index range <>) of Opt_Field_Offset; + end Types; diff --git a/gcc/ada/types.h b/gcc/ada/types.h index d78d9d8806c..15ebf2b6736 100644 --- a/gcc/ada/types.h +++ b/gcc/ada/types.h @@ -360,6 +360,18 @@ typedef Int Mechanism_Type; #define By_Short_Descriptor_NCA (-18) #define By_Short_Descriptor_Last (-18) +typedef char Component_Alignment_Kind; +#define Calign_Default 0 +#define Calign_Component_Size 1 +#define Calign_Component_Size_4 2 +#define Calign_Storage_Unit 3 + +typedef char Float_Rep_Kind; +#define IEEE_Binary 0 +#define AAMP 1 + +typedef Nat Small_Paren_Count_Type; + /* Definitions of Reason codes for Raise_xxx_Error nodes */ #define CE_Access_Check_Failed 0 #define CE_Access_Parameter_Is_Null 1 @@ -403,3 +415,104 @@ typedef Int Mechanism_Type; #define SE_Object_Too_Large 35 #define LAST_REASON_CODE 37 + +typedef Nat Field_Offset; + +typedef struct +{ + unsigned f0 : 1; + unsigned f1 : 1; + unsigned f2 : 1; + unsigned f3 : 1; + unsigned f4 : 1; + unsigned f5 : 1; + unsigned f6 : 1; + unsigned f7 : 1; + unsigned f8 : 1; + unsigned f9 : 1; + unsigned f10 : 1; + unsigned f11 : 1; + unsigned f12 : 1; + unsigned f13 : 1; + unsigned f14 : 1; + unsigned f15 : 1; + unsigned f16 : 1; + unsigned f17 : 1; + unsigned f18 : 1; + unsigned f19 : 1; + unsigned f20 : 1; + unsigned f21 : 1; + unsigned f22 : 1; + unsigned f23 : 1; + unsigned f24 : 1; + unsigned f25 : 1; + unsigned f26 : 1; + unsigned f27 : 1; + unsigned f28 : 1; + unsigned f29 : 1; + unsigned f30 : 1; + unsigned f31 : 1; +} slot_1_bit; + +typedef struct +{ + unsigned f0 : 2; + unsigned f1 : 2; + unsigned f2 : 2; + unsigned f3 : 2; + unsigned f4 : 2; + unsigned f5 : 2; + unsigned f6 : 2; + unsigned f7 : 2; + unsigned f8 : 2; + unsigned f9 : 2; + unsigned f10 : 2; + unsigned f11 : 2; + unsigned f12 : 2; + unsigned f13 : 2; + unsigned f14 : 2; + unsigned f15 : 2; +} slot_2_bit; + +typedef struct +{ + unsigned f0 : 4; + unsigned f1 : 4; + unsigned f2 : 4; + unsigned f3 : 4; + unsigned f4 : 4; + unsigned f5 : 4; + unsigned f6 : 4; + unsigned f7 : 4; +} slot_4_bit; + +typedef struct +{ + unsigned f0 : 8; + unsigned f1 : 8; + unsigned f2 : 8; + unsigned f3 : 8; +} slot_8_bit; + +typedef Union_Id slot_32_bit; + +typedef union +{ + slot_1_bit slot_1; + slot_2_bit slot_2; + slot_4_bit slot_4; + slot_8_bit slot_8; + slot_32_bit slot_32; +} slot; + +// Slots are 32 bits (???for now, but we might want to make that 64). +// The first bootstrap stage uses -std=gnu++98, so we can't use +// static_assert in that case. +#if __cplusplus >= 201402L +static_assert(sizeof(slot_1_bit) == 4); +static_assert(sizeof(slot_2_bit) == 4); +static_assert(sizeof(slot_4_bit) == 4); +static_assert(sizeof(slot_8_bit) == 4); +static_assert(sizeof(slot_32_bit) == 4); +static_assert(sizeof(slot) == 4); +#endif diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 61230b255f4..02f8c59dc60 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -25,12 +25,15 @@ with Atree; use Atree; with Casing; use Casing; -with Einfo; use Einfo; +with Einfo; use Einfo; +with Einfo.Utils; use Einfo.Utils; with Hostparm; with Lib; use Lib; with Nlists; use Nlists; with Output; use Output; -with Sinfo; use Sinfo; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; with Sinput; use Sinput; package body Uname is diff --git a/gcc/ada/xeinfo.adb b/gcc/ada/xeinfo.adb deleted file mode 100644 index 81bd9b86c38..00000000000 --- a/gcc/ada/xeinfo.adb +++ /dev/null @@ -1,551 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X E I N F O -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-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. -- --- -- ------------------------------------------------------------------------------- - --- Program to construct C header file einfo.h (C version of einfo.ads spec) --- for use by Gigi. This header file contains all definitions and access --- functions, but does not contain set procedures, since Gigi is not allowed --- to modify the GNAT tree. - --- Input files: - --- einfo.ads spec of Einfo package --- einfo.adb body of Einfo package - --- Output files: - --- einfo.h corresponding C header file - --- Note: It is assumed that the input files have been compiled without errors - --- An optional argument allows the specification of an output file name to --- override the default einfo.h file name for the generated output file. - --- Most, but not all of the functions in Einfo can be inlined in the C header. --- They are the functions identified by pragma Inline in the spec. Functions --- that cannot be inlined are simply defined in the header. - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Strings.Maps; use Ada.Strings.Maps; -with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; -with GNAT.Spitbol.Table_Boolean; use GNAT.Spitbol.Table_Boolean; - -with CEinfo; - -procedure XEinfo is - - package TB renames GNAT.Spitbol.Table_Boolean; - - Err : exception; - - A : VString := Nul; - B : VString := Nul; - C : VString := Nul; - Expr : VString := Nul; - Filler : VString := Nul; - Fline : VString := Nul; - Formal : VString := Nul; - Formaltyp : VString := Nul; - FN : VString := Nul; - Line : VString := Nul; - N : VString := Nul; - N1 : VString := Nul; - N2 : VString := Nul; - N3 : VString := Nul; - Nam : VString := Nul; - Name : VString := Nul; - NewS : VString := Nul; - Nextlin : VString := Nul; - OldS : VString := Nul; - Rtn : VString := Nul; - Term : VString := Nul; - - InB : File_Type; - -- Used to read initial header from body - - InF : File_Type; - -- Used to read full text of both spec and body - - Ofile : File_Type; - -- Used to write output file - - wsp : constant Pattern := NSpan (' ' & ASCII.HT); - Comment : constant Pattern := wsp & "--"; - For_Rep : constant Pattern := wsp & "for"; - Get_Func : constant Pattern := wsp * A & "function" & wsp - & Break (' ') * Name; - Inline : constant Pattern := wsp & "pragma Inline (" & Break (')') * Name; - Get_Pack : constant Pattern := wsp & "package "; - Get_Enam : constant Pattern := wsp & Break (',') * N & ','; - Find_Fun : constant Pattern := wsp & "function"; - F_Subtyp : constant Pattern := wsp * A & "subtype " & Break (' ') * N; - G_Subtyp : constant Pattern := wsp & "subtype" & wsp & Break (' ') * NewS - & wsp & "is" & wsp & Break (" ;") * OldS - & wsp & ';' & wsp & Rtab (0); - F_Typ : constant Pattern := wsp * A & "type " & Break (' ') * N & - " is ("; - Get_Nam : constant Pattern := wsp * A & Break (",)") * Nam - & Len (1) * Term; - Get_Styp : constant Pattern := wsp * A & "subtype " & Break (' ') * N; - Get_N1 : constant Pattern := wsp & Break (' ') * N1; - Get_N2 : constant Pattern := wsp & "-- " & Rest * N2; - Get_N3 : constant Pattern := wsp & Break (';') * N3; - Get_FN : constant Pattern := wsp * C & "function" & wsp - & Break (" (") * FN; - Is_Rturn : constant Pattern := BreakX ('r') & "return"; - Is_Begin : constant Pattern := wsp & "begin"; - Get_Asrt : constant Pattern := wsp & "pragma Assert"; - Semicoln : constant Pattern := BreakX (';'); - Get_Cmnt : constant Pattern := BreakX ('-') * A & "--"; - Get_Expr : constant Pattern := wsp & "return " & Break (';') * Expr; - Chek_End : constant Pattern := wsp & "end" & BreakX (';') & ';'; - Get_B0 : constant Pattern := BreakX (' ') * A & " or else " & Rest * B; - Get_B1 : constant Pattern := BreakX (' ') * A & " in " & Rest * B; - Get_B2 : constant Pattern := BreakX (' ') * A & " = " & Rest * B; - Get_B3 : constant Pattern := BreakX (' ') * A & " /= " & Rest * B; - To_Paren : constant Pattern := wsp * Filler & '('; - Get_Fml : constant Pattern := Break (" :") * Formal & wsp & ':' & wsp - & BreakX (" );") * Formaltyp; - Nxt_Fml : constant Pattern := wsp & "; "; - Get_Rtn : constant Pattern := wsp & "return" & wsp & BreakX (" ;") * Rtn; - Rem_Prn : constant Pattern := wsp & ')'; - - M : Match_Result; - - Lineno : Natural := 0; - -- Line number in spec - - V : Natural; - Ctr : Natural; - - Inlined : TB.Table (200); - -- Inlined<N> = True for inlined function, False otherwise - - Lastinlined : Boolean; - - procedure Badfunc; - pragma No_Return (Badfunc); - -- Signal bad function in body - - function Getlin return VString; - -- Get non-comment line (comment lines skipped, also skips FOR rep clauses) - -- Fatal error (raises End_Error exception) if end of file encountered - - procedure Must (B : Boolean); - -- Raises Err if the argument (a Match) call, returns False - - procedure Sethead (Line : in out VString; Term : String); - -- Process function header into C - - procedure Translate_Expr (Expr : in out VString); - -- Translate expression from Ada to C - - ------------- - -- Badfunc -- - ------------- - - procedure Badfunc is - begin - Put_Line - (Standard_Error, - "Body for function " & FN & " does not meet requirements"); - raise Err; - end Badfunc; - - ------------- - -- Getlin -- - ------------- - - function Getlin return VString is - Lin : VString; - - begin - loop - Lin := Get_Line (InF); - Lineno := Lineno + 1; - - if Lin /= "" - and then not Match (Lin, Comment) - and then not Match (Lin, For_Rep) - then - return Lin; - end if; - end loop; - end Getlin; - - ---------- - -- Must -- - ---------- - - procedure Must (B : Boolean) is - begin - if not B then - raise Err; - end if; - end Must; - - ------------- - -- Sethead -- - ------------- - - procedure Sethead (Line : in out VString; Term : String) is - Args : VString; - - begin - Must (Match (Line, Get_Func, "")); - Args := Nul; - - if Match (Line, To_Paren, "") then - Args := Filler & '('; - - loop - Must (Match (Line, Get_Fml, "")); - Append (Args, Formaltyp & ' ' & Formal); - exit when not Match (Line, Nxt_Fml); - Append (Args, ","); - end loop; - - Match (Line, Rem_Prn, ""); - Append (Args, ')'); - end if; - - Must (Match (Line, Get_Rtn)); - - if Present (Inlined, Name) then - Put_Line (Ofile, A & "INLINE " & Rtn & ' ' & Name & Args & Term); - else - Put_Line (Ofile, A & Rtn & ' ' & Name & Args & Term); - end if; - end Sethead; - - -------------------- - -- Translate_Expr -- - -------------------- - - procedure Translate_Expr (Expr : in out VString) is - M : Match_Result; - - begin - Match (Expr, Get_B1, M); - Replace (M, "IN (" & A & ", " & B & ')'); - Match (Expr, Get_B2, M); - Replace (M, A & " == " & B); - Match (Expr, Get_B3, M); - Replace (M, A & " != " & B); - end Translate_Expr; - --- Start of processing for XEinfo - -begin - -- First run CEinfo to check for errors. Note that CEinfo is also a - -- stand-alone program that can be run separately. - - CEinfo; - - Anchored_Mode := True; - - if Argument_Count > 0 then - Create (Ofile, Out_File, Argument (1)); - else - Create (Ofile, Out_File, "einfo.h"); - end if; - - Open (InB, In_File, "einfo.adb"); - Open (InF, In_File, "einfo.ads"); - - Lineno := 0; - loop - Line := Get_Line (InF); - Lineno := Lineno + 1; - exit when Line = ""; - - Match (Line, - "-- S p e c ", - "-- C Header File "); - Match (Line, "--", "/*"); - Match (Line, Rtab (2) * A & "--", M); - Replace (M, A & "*/"); - Put_Line (Ofile, Line); - end loop; - - Put_Line (Ofile, ""); - - Put_Line (Ofile, "#ifdef __cplusplus"); - Put_Line (Ofile, "extern ""C"" {"); - Put_Line (Ofile, "#endif"); - - -- Find and record pragma Inlines - - loop - Line := Get_Line (InF); - exit when Match (Line, " -- END XEINFO INLINES"); - - if Match (Line, Inline) then - Set (Inlined, Name, True); - end if; - end loop; - - -- Skip to package line - - Reset (InF, In_File); - Lineno := 0; - - loop - Line := Getlin; - exit when Match (Line, Get_Pack); - end loop; - - V := 0; - Line := Getlin; - Must (Match (Line, wsp & "type Entity_Kind")); - - -- Process entity kind code definitions - - loop - Line := Getlin; - exit when not Match (Line, Get_Enam); - Put_Line (Ofile, " #define " & Rpad (N, 32) & " " & V); - V := V + 1; - end loop; - - Must (Match (Line, wsp & Rest * N)); - Put_Line (Ofile, " #define " & Rpad (N, 32) & ' ' & V); - Line := Getlin; - - Must (Match (Line, wsp & ");")); - Put_Line (Ofile, ""); - - -- Loop through subtype and type declarations - - loop - Line := Getlin; - exit when Match (Line, Find_Fun); - - -- Case of a subtype declaration - - if Match (Line, F_Subtyp) then - - -- Case of a subtype declaration that is an abbreviation of the - -- form subtype x is y, and if so generate the appropriate typedef - - if Match (Line, G_Subtyp) then - Put_Line (Ofile, A & "typedef " & OldS & ' ' & NewS & ';'); - - -- Otherwise the subtype must be declaring a subrange of Entity_Id - - else - Must (Match (Line, Get_Styp)); - Line := Getlin; - Must (Match (Line, Get_N1)); - - loop - Line := Get_Line (InF); - Lineno := Lineno + 1; - exit when not Match (Line, Get_N2); - end loop; - - Must (Match (Line, Get_N3)); - Put_Line (Ofile, A & "SUBTYPE (" & N & ", Entity_Kind, "); - Put_Line (Ofile, A & " " & N1 & ", " & N3 & ')'); - Put_Line (Ofile, ""); - end if; - - -- Case of type declaration - - elsif Match (Line, F_Typ) then - - -- Process type declaration (must be enumeration type) - - Ctr := 0; - Put_Line (Ofile, A & "typedef char " & N & ';'); - - loop - Line := Getlin; - Must (Match (Line, Get_Nam)); - Put_Line (Ofile, A & "#define " & Rpad (Nam, 25) & Ctr); - Ctr := Ctr + 1; - exit when Term /= ","; - end loop; - - Put_Line (Ofile, ""); - - -- Neither subtype nor type declaration - - else - raise Err; - end if; - end loop; - - -- Process function declarations - - -- Note: Lastinlined used to control blank lines - - Put_Line (Ofile, ""); - Lastinlined := True; - - -- Loop through function declarations - - while Match (Line, Get_FN) loop - - -- Non-inlined function - - if not Present (Inlined, FN) then - Put_Line (Ofile, ""); - Put_Line - (Ofile, - " #define " & FN & " einfo__" & Translate (FN, Lower_Case_Map)); - - -- Inlined function - - else - if not Lastinlined then - Put_Line (Ofile, ""); - end if; - end if; - - -- Merge here to output spec - - Sethead (Line, ";"); - Lastinlined := Get (Inlined, FN); - Line := Getlin; - end loop; - - Put_Line (Ofile, ""); - - -- Read body to find inlined functions - - Close (InB); - Close (InF); - Open (InF, In_File, "einfo.adb"); - Lineno := 0; - - -- Loop through input lines to find bodies of inlined functions - - while not End_Of_File (InF) loop - Fline := Get_Line (InF); - - if Match (Fline, Get_FN) - and then Get (Inlined, FN) - then - -- Here we have an inlined function - - if not Match (Fline, Is_Rturn) then - Line := Fline; - Badfunc; - end if; - - Line := Getlin; - - if not Match (Line, Is_Begin) then - Badfunc; - end if; - - -- Skip past pragma Asserts - - loop - Line := Getlin; - exit when not Match (Line, Get_Asrt); - - -- Pragma assert found, get its continuation lines - - loop - exit when Match (Line, Semicoln); - Line := Getlin; - end loop; - end loop; - - -- Process return statement - - Match (Line, Get_Cmnt, M); - Replace (M, A); - - -- Get continuations of return statement - - while not Match (Line, Semicoln) loop - Nextlin := Getlin; - Match (Nextlin, wsp, " "); - Append (Line, Nextlin); - end loop; - - if not Match (Line, Get_Expr) then - Badfunc; - end if; - - Line := Getlin; - - if not Match (Line, Chek_End) then - Badfunc; - end if; - - -- Process expression - - if Match (Expr, Get_B0, M) then - declare - Saved_A : VString := A; - Saved_B : VString := B; - begin - Translate_Expr (Saved_A); - Translate_Expr (Saved_B); - Replace (M, Saved_A & " || " & Saved_B); - end; - else - Translate_Expr (Expr); - end if; - - Put_Line (Ofile, ""); - Sethead (Fline, ""); - Put_Line (Ofile, C & " { return " & Expr & "; }"); - end if; - end loop; - - Put_Line (Ofile, ""); - - Put_Line (Ofile, "#ifdef __cplusplus"); - Put_Line (Ofile, "}"); - Put_Line (Ofile, "#endif"); - - Put_Line - (Ofile, - "/* End of einfo.h (C version of Einfo package specification) */"); - - Close (InF); - Close (Ofile); - -exception - when Err => - Put_Line (Standard_Error, Lineno & ". " & Line); - Put_Line (Standard_Error, "**** fatal error ****"); - Set_Exit_Status (1); - - when End_Error => - Put_Line (Standard_Error, "unexpected end of file"); - Put_Line (Standard_Error, "**** fatal error ****"); - -end XEinfo; diff --git a/gcc/ada/xnmake.adb b/gcc/ada/xnmake.adb deleted file mode 100644 index 952e3f77345..00000000000 --- a/gcc/ada/xnmake.adb +++ /dev/null @@ -1,467 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X N M A K E -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-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. -- --- -- ------------------------------------------------------------------------------- - --- Program to construct the spec and body of the Nmake package - --- Input files: - --- sinfo.ads Spec of Sinfo package --- nmake.adt Template for Nmake package - --- Output files: - --- nmake.ads Spec of Nmake package --- nmake.adb Body of Nmake package - --- Note: this program assumes that sinfo.ads has passed the error checks that --- are carried out by the csinfo utility, so it does not duplicate these --- checks and assumes that sinfo.ads has the correct form. - --- In the absence of any switches, both the ads and adb files are output. --- The switch -s or /s indicates that only the ads file is to be output. --- The switch -b or /b indicates that only the adb file is to be output. - --- If a file name argument is given, then the output is written to this file --- rather than to nmake.ads or nmake.adb. A file name can only be given if --- exactly one of the -s or -b options is present. - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Strings.Maps; use Ada.Strings.Maps; -with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; - -with XUtil; - -procedure XNmake is - - Err : exception; - -- Raised to terminate execution - - A : VString := Nul; - Arg : VString := Nul; - Arg_List : VString := Nul; - Comment : VString := Nul; - Default : VString := Nul; - Field : VString := Nul; - Line : VString := Nul; - Node : VString := Nul; - Op_Name : VString := Nul; - Prevl : VString := Nul; - Synonym : VString := Nul; - X : VString := Nul; - - NWidth : Natural; - - FileS : VString := V ("nmake.ads"); - FileB : VString := V ("nmake.adb"); - -- Set to null if corresponding file not to be generated - - Given_File : VString := Nul; - -- File name given by command line argument - - subtype Sfile is Ada.Streams.Stream_IO.File_Type; - - InS, InT : Ada.Text_IO.File_Type; - OutS, OutB : Sfile; - - wsp : constant Pattern := Span (' ' & ASCII.HT); - - Body_Only : constant Pattern := BreakX (' ') * X - & Span (' ') & "-- body only"; - Spec_Only : constant Pattern := BreakX (' ') * X - & Span (' ') & "-- spec only"; - - Node_Hdr : constant Pattern := wsp & "-- N_" & Rest * Node; - Punc : constant Pattern := BreakX (" .,"); - - Binop : constant Pattern := wsp - & "-- plus fields for binary operator"; - Unop : constant Pattern := wsp - & "-- plus fields for unary operator"; - Syn : constant Pattern := wsp & "-- " & Break (' ') * Synonym - & " (" & Break (')') * Field - & Rest * Comment; - - Templ : constant Pattern := BreakX ('T') * A & "T e m p l a t e"; - Spec : constant Pattern := BreakX ('S') * A & "S p e c"; - - Sem_Field : constant Pattern := BreakX ('-') & "-Sem"; - Lib_Field : constant Pattern := BreakX ('-') & "-Lib"; - - Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field; - - Get_Dflt : constant Pattern := BreakX ('(') & "(set to " - & Break (" ") * Default & " if"; - - Next_Arg : constant Pattern := Break (',') * Arg & ','; - - Op_Node : constant Pattern := "Op_" & Rest * Op_Name; - - Shft_Rot : constant Pattern := "Shift_" or "Rotate_"; - - No_Ent : constant Pattern := "Or_Else" or "And_Then" - or "In" or "Not_In"; - - M : Match_Result; - - V_String_Id : constant VString := V ("String_Id"); - V_Node_Id : constant VString := V ("Node_Id"); - V_Name_Id : constant VString := V ("Name_Id"); - V_List_Id : constant VString := V ("List_Id"); - V_Elist_Id : constant VString := V ("Elist_Id"); - V_Boolean : constant VString := V ("Boolean"); - - procedure Put_Line (F : Sfile; S : String) renames XUtil.Put_Line; - procedure Put_Line (F : Sfile; S : VString) renames XUtil.Put_Line; - -- Local version of Put_Line ensures Unix style line endings - - procedure WriteS (S : String); - procedure WriteB (S : String); - procedure WriteBS (S : String); - procedure WriteS (S : VString); - procedure WriteB (S : VString); - procedure WriteBS (S : VString); - -- Write given line to spec or body file or both if active - - procedure WriteB (S : String) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - end WriteB; - - procedure WriteB (S : VString) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - end WriteB; - - procedure WriteBS (S : String) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteBS; - - procedure WriteBS (S : VString) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteBS; - - procedure WriteS (S : String) is - begin - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteS; - - procedure WriteS (S : VString) is - begin - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteS; - --- Start of processing for XNmake - -begin - NWidth := 28; - Anchored_Mode := True; - - for ArgN in 1 .. Argument_Count loop - declare - Arg : constant String := Argument (ArgN); - - begin - if Arg (1) = '-' then - if Arg'Length = 2 - and then (Arg (2) = 'b' or else Arg (2) = 'B') - then - FileS := Nul; - - elsif Arg'Length = 2 - and then (Arg (2) = 's' or else Arg (2) = 'S') - then - FileB := Nul; - - else - raise Err; - end if; - - else - if Given_File /= Nul then - raise Err; - else - Given_File := V (Arg); - end if; - end if; - end; - end loop; - - if FileS = Nul and then FileB = Nul then - raise Err; - - elsif Given_File /= Nul then - if FileB = Nul then - FileS := Given_File; - - elsif FileS = Nul then - FileB := Given_File; - - else - raise Err; - end if; - end if; - - Open (InS, In_File, "sinfo.ads"); - Open (InT, In_File, "nmake.adt"); - - if FileS /= Nul then - Create (OutS, Out_File, S (FileS)); - end if; - - if FileB /= Nul then - Create (OutB, Out_File, S (FileB)); - end if; - - Anchored_Mode := True; - - -- Copy initial part of template to spec and body - - loop - Line := Get_Line (InT); - - -- Skip lines describing the template - - if Match (Line, "-- This file is a template") then - loop - Line := Get_Line (InT); - exit when Line = ""; - end loop; - end if; - - -- Loop keeps going until "package" keyword written - - exit when Match (Line, "package"); - - -- Deal with WITH lines, writing to body or spec as appropriate - - if Match (Line, Body_Only, M) then - Replace (M, X); - WriteB (Line); - - elsif Match (Line, Spec_Only, M) then - Replace (M, X); - WriteS (Line); - - -- Change header from Template to Spec and write to spec file - - else - if Match (Line, Templ, M) then - Replace (M, A & " S p e c "); - end if; - - WriteS (Line); - - -- Write header line to body file - - if Match (Line, Spec, M) then - Replace (M, A & "B o d y"); - end if; - - WriteB (Line); - end if; - end loop; - - -- Package line reached - - WriteS ("package Nmake is"); - WriteB ("package body Nmake is"); - WriteB (""); - - -- Copy rest of lines up to template insert point to spec only - - loop - Line := Get_Line (InT); - exit when Match (Line, "!!TEMPLATE INSERTION POINT"); - WriteS (Line); - end loop; - - -- Here we are doing the actual insertions, loop through node types - - loop - Line := Get_Line (InS); - - if Match (Line, Node_Hdr) - and then not Match (Node, Punc) - and then Node /= "Unused" - then - exit when Node = "Empty"; - Prevl := " function Make_" & Node & " (Sloc : Source_Ptr"; - Arg_List := Nul; - - -- Loop through fields of one node - - loop - Line := Get_Line (InS); - exit when Line = ""; - - if Match (Line, Binop) then - WriteBS (Prevl & ';'); - Append (Arg_List, "Left_Opnd,Right_Opnd,"); - WriteBS ( - " " & Rpad ("Left_Opnd", NWidth) & " : Node_Id;"); - Prevl := - " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; - - elsif Match (Line, Unop) then - WriteBS (Prevl & ';'); - Append (Arg_List, "Right_Opnd,"); - Prevl := " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; - - elsif Match (Line, Syn) then - if Synonym /= "Prev_Ids" - and then Synonym /= "More_Ids" - and then Synonym /= "Comes_From_Source" - and then Synonym /= "Paren_Count" - and then not Match (Field, Sem_Field) - and then not Match (Field, Lib_Field) - then - Match (Field, Get_Field); - - if Field = "Str" then - Field := V_String_Id; - elsif Field = "Node" then - Field := V_Node_Id; - elsif Field = "Name" then - Field := V_Name_Id; - elsif Field = "List" then - Field := V_List_Id; - elsif Field = "Elist" then - Field := V_Elist_Id; - elsif Field = "Flag" then - Field := V_Boolean; - end if; - - if Field = "Boolean" then - Default := V ("False"); - else - Default := Nul; - end if; - - Match (Comment, Get_Dflt); - - WriteBS (Prevl & ';'); - Append (Arg_List, Synonym & ','); - Rpad (Synonym, NWidth); - - if Default = "" then - Prevl := " " & Synonym & " : " & Field; - else - Prevl := - " " & Synonym & " : " & Field & " := " & Default; - end if; - end if; - end if; - end loop; - - WriteBS (Prevl & ')'); - WriteS (" return Node_Id;"); - WriteS (" pragma Inline (Make_" & Node & ");"); - WriteB (" return Node_Id"); - WriteB (" is"); - WriteB (" N : constant Node_Id :="); - - if Match (Node, "Defining_Identifier") or else - Match (Node, "Defining_Character") or else - Match (Node, "Defining_Operator") - then - WriteB (" New_Entity (N_" & Node & ", Sloc);"); - else - WriteB (" New_Node (N_" & Node & ", Sloc);"); - end if; - - WriteB (" begin"); - - while Match (Arg_List, Next_Arg, "") loop - if Length (Arg) < NWidth then - WriteB (" Set_" & Arg & " (N, " & Arg & ");"); - else - WriteB (" Set_" & Arg); - WriteB (" (N, " & Arg & ");"); - end if; - end loop; - - if Match (Node, Op_Node) then - if Node = "Op_Plus" then - WriteB (" Set_Chars (N, Name_Op_Add);"); - - elsif Node = "Op_Minus" then - WriteB (" Set_Chars (N, Name_Op_Subtract);"); - - elsif Match (Op_Name, Shft_Rot) then - WriteB (" Set_Chars (N, Name_" & Op_Name & ");"); - - else - WriteB (" Set_Chars (N, Name_" & Node & ");"); - end if; - - if not Match (Op_Name, No_Ent) then - WriteB (" Set_Entity (N, Standard_" & Node & ");"); - end if; - end if; - - WriteB (" return N;"); - WriteB (" end Make_" & Node & ';'); - WriteBS (""); - end if; - end loop; - - WriteBS ("end Nmake;"); - -exception - - when Err => - Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]"); - Set_Exit_Status (1); - -end XNmake; diff --git a/gcc/ada/xsinfo.adb b/gcc/ada/xsinfo.adb deleted file mode 100644 index c4488d9fd94..00000000000 --- a/gcc/ada/xsinfo.adb +++ /dev/null @@ -1,262 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X S I N F O -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-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. -- --- -- ------------------------------------------------------------------------------- - --- Program to construct C header file sinfo.h (C version of sinfo.ads spec, --- for use by Gigi, contains all definitions and access functions, but does --- not contain set procedures, since Gigi never modifies the GNAT tree) - --- Input files: - --- sinfo.ads Spec of Sinfo package - --- Output files: - --- sinfo.h Corresponding c header file - --- An optional argument allows the specification of an output file name to --- override the default sinfo.h file name for the generated output file. - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; - -with CSinfo; - -procedure XSinfo is - - Done : exception; - Err : exception; - - A : VString := Nul; - Arg : VString := Nul; - Comment : VString := Nul; - Line : VString := Nul; - N : VString := Nul; - N1, N2 : VString := Nul; - Nam : VString := Nul; - Rtn : VString := Nul; - Term : VString := Nul; - - InS : File_Type; - Ofile : File_Type; - - wsp : constant Pattern := Span (' ' & ASCII.HT); - Wsp_For : constant Pattern := wsp & "for"; - Is_Cmnt : constant Pattern := wsp & "--"; - Typ_Nod : constant Pattern := wsp * A & "type Node_Kind is"; - Get_Nam : constant Pattern := wsp * A & "N_" & Break (",)") * Nam - & Len (1) * Term; - Sub_Typ : constant Pattern := wsp * A & "subtype " & Break (' ') * N; - No_Cont : constant Pattern := wsp & Break (' ') * N1 - & " .. " & Break (';') * N2; - Cont_N1 : constant Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0); - Cont_N2 : constant Pattern := Span (' ') & Break (';') * N2; - Is_Func : constant Pattern := wsp * A & "function " & Rest * Nam; - Get_Arg : constant Pattern := wsp & "(N : " & Break (')') * Arg - & ") return " & Break (';') * Rtn - & ';' & wsp & "--" & wsp & Rest * Comment; - - NKV : Natural; - - M : Match_Result; - - procedure Getline; - -- Get non-comment, non-blank line. Also skips "for " rep clauses - - ------------- - -- Getline -- - ------------- - - procedure Getline is - begin - loop - Line := Get_Line (InS); - - if Line /= "" - and then not Match (Line, Wsp_For) - and then not Match (Line, Is_Cmnt) - then - return; - - elsif Match (Line, " -- End functions (note") then - raise Done; - end if; - end loop; - end Getline; - --- Start of processing for XSinfo - -begin - -- First run CSinfo to check for errors. Note that CSinfo is also a - -- stand-alone program that can be run separately. - - CSinfo; - - Set_Exit_Status (1); - Anchored_Mode := True; - - if Argument_Count > 0 then - Create (Ofile, Out_File, Argument (1)); - else - Create (Ofile, Out_File, "sinfo.h"); - end if; - - Open (InS, In_File, "sinfo.ads"); - - -- Write header to output file - - loop - Line := Get_Line (InS); - exit when Line = ""; - - Match - (Line, - "-- S p e c ", - "-- C Header File "); - - Match (Line, "--", "/*"); - Match (Line, Rtab (2) * A & "--", M); - Replace (M, A & "*/"); - Put_Line (Ofile, Line); - end loop; - - -- Skip to package line - - loop - Getline; - exit when Match (Line, "package"); - end loop; - - -- Skip to first node kind line - - loop - Getline; - exit when Match (Line, Typ_Nod); - Put_Line (Ofile, Line); - end loop; - - Put_Line (Ofile, ""); - - Put_Line (Ofile, "#ifdef __cplusplus"); - Put_Line (Ofile, "extern ""C"" {"); - Put_Line (Ofile, "#endif"); - - NKV := 0; - - -- Loop through node kind codes - - loop - Getline; - - if Match (Line, Get_Nam) then - Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV); - NKV := NKV + 1; - exit when not Match (Term, ","); - - else - Put_Line (Ofile, Line); - end if; - end loop; - - Put_Line (Ofile, ""); - Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV); - - -- Loop through subtype declarations - - loop - Getline; - - if not Match (Line, Sub_Typ) then - exit when Match (Line, " function"); - Put_Line (Ofile, Line); - - else - Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, "); - Getline; - - -- Normal case - - if Match (Line, No_Cont) then - Put_Line (Ofile, A & " " & N1 & ", " & N2 & ')'); - - -- Continuation case - - else - if not Match (Line, Cont_N1) then - raise Err; - end if; - - Getline; - - if not Match (Line, Cont_N2) then - raise Err; - end if; - - Put_Line (Ofile, A & " " & N1 & ','); - Put_Line (Ofile, A & " " & N2 & ')'); - end if; - end if; - end loop; - - -- Loop through functions. Note that this loop is terminated by - -- the call to Getfile encountering the end of functions sentinel - - loop - if Match (Line, Is_Func) then - Getline; - if not Match (Line, Get_Arg) then - raise Err; - end if; - Put_Line - (Ofile, - A & "INLINE " & Rpad (Rtn, 9) - & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)"); - - Put_Line (Ofile, A & " { return " & Comment & " (N); }"); - - else - Put_Line (Ofile, Line); - end if; - - Getline; - end loop; - - -- Can't get here since above loop only left via raise - -exception - when Done => - Close (InS); - Put_Line (Ofile, ""); - Put_Line (Ofile, "#ifdef __cplusplus"); - Put_Line (Ofile, "}"); - Put_Line (Ofile, "#endif"); - Close (Ofile); - Set_Exit_Status (0); - -end XSinfo; diff --git a/gcc/ada/xtreeprs.adb b/gcc/ada/xtreeprs.adb deleted file mode 100644 index f6410a8072c..00000000000 --- a/gcc/ada/xtreeprs.adb +++ /dev/null @@ -1,357 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X T R E E P R S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-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. -- --- -- ------------------------------------------------------------------------------- - --- Program to construct the spec of the Treeprs package - --- Input files: - --- sinfo.ads Spec of Sinfo package --- treeprs.adt Template for Treeprs package - --- Output files: - --- treeprs.ads Spec of Treeprs package - --- Note: this program assumes that sinfo.ads has passed the error checks which --- are carried out by the CSinfo utility so it does not duplicate these checks - --- An optional argument allows the specification of an output file name to --- override the default treeprs.ads file name for the generated output file. - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; -with GNAT.Spitbol.Table_Boolean; use GNAT.Spitbol.Table_Boolean; -with GNAT.Spitbol.Table_VString; use GNAT.Spitbol.Table_VString; - -procedure XTreeprs is - - package TB renames GNAT.Spitbol.Table_Boolean; - package TV renames GNAT.Spitbol.Table_VString; - - Err : exception; - -- Raised on fatal error - - A : VString := Nul; - Ffield : VString := Nul; - Field : VString := Nul; - Fieldno : VString := Nul; - Flagno : VString := Nul; - Line : VString := Nul; - Name : VString := Nul; - Node : VString := Nul; - Outstring : VString := Nul; - Prefix : VString := Nul; - S : VString := Nul; - S1 : VString := Nul; - Syn : VString := Nul; - Synonym : VString := Nul; - Term : VString := Nul; - - subtype Sfile is Ada.Streams.Stream_IO.File_Type; - - OutS : Sfile; - -- Output file - - InS : Ada.Text_IO.File_Type; - -- Read sinfo.ads - - InT : Ada.Text_IO.File_Type; - -- Read treeprs.adt - - Special : TB.Table (20); - -- Table of special fields. These fields are not included in the table - -- constructed by Xtreeprs, since they are specially handled in treeprs. - -- This means these field definitions are completely ignored. - - Names : array (1 .. 500) of VString; - -- Table of names of synonyms - - Positions : array (1 .. 500) of Natural; - -- Table of starting positions in Pchars string for synonyms - - Strings : TV.Table (300); - -- Contribution of each synonym to Pchars string, indexed by name - - Count : Natural := 0; - -- Number of synonyms processed so far - - Curpos : Natural := 1; - -- Number of characters generated in Pchars string so far - - Lineno : Natural := 0; - -- Line number in sinfo.ads - - Field_Base : constant := Character'Pos ('#'); - -- Fields 1-5 are represented by the characters #$%&' (i.e. by five - -- contiguous characters starting at # (16#23#)). - - Flag_Base : constant := Character'Pos ('('); - -- Flags 1-18 are represented by the characters ()*+,-./0123456789 - -- (i.e. by 18 contiguous characters starting at (16#28#)). - - Fieldch : Character; - -- Field character, as per above tables - - Sp : aliased Natural; - -- Space left on line for Pchars output - - wsp : constant Pattern := Span (' ' & ASCII.HT); - Is_Temp : constant Pattern := BreakX ('T') * A & "T e m p l a t e"; - Get_Node : constant Pattern := wsp & "-- N_" & Rest * Node; - Tst_Punc : constant Pattern := Break (" ,."); - Get_Syn : constant Pattern := Span (' ') & "-- " & Break (' ') * Synonym - & " (" & Break (')') * Field; - Brk_Min : constant Pattern := Break ('-') * Ffield; - Is_Flag : constant Pattern := "Flag" & Rest * Flagno; - Is_Field : constant Pattern := Rtab (1) & Len (1) * Fieldno; - Is_Syn : constant Pattern := wsp & "N_" & Break (",)") * Syn - & Len (1) * Term; - Brk_Node : constant Pattern := Break (' ') * Node & ' '; - Chop_SP : constant Pattern := Len (Sp'Unrestricted_Access) * S1; - - M : Match_Result; - - procedure Put_Line (F : Sfile; S : String); - procedure Put_Line (F : Sfile; S : VString); - -- Local version of Put_Line ensures Unix style line endings - - procedure Put_Line (F : Sfile; S : String) is - begin - String'Write (Stream (F), S); - Character'Write (Stream (F), ASCII.LF); - end Put_Line; - - procedure Put_Line (F : Sfile; S : VString) is - begin - Put_Line (F, To_String (S)); - end Put_Line; - --- Start of processing for XTreeprs - -begin - Anchored_Mode := True; - - if Argument_Count > 0 then - Create (OutS, Out_File, Argument (1)); - else - Create (OutS, Out_File, "treeprs.ads"); - end if; - - Open (InS, In_File, "sinfo.ads"); - Open (InT, In_File, "treeprs.adt"); - - -- Initialize special fields table - - Set (Special, "Analyzed", True); - Set (Special, "Cannot_Be_Constant", True); - Set (Special, "Chars", True); - Set (Special, "Comes_From_Source", True); - Set (Special, "Error_Posted", True); - Set (Special, "Etype", True); - Set (Special, "Has_No_Side_Effects", True); - Set (Special, "Is_Controlling_Actual", True); - Set (Special, "Is_Overloaded", True); - Set (Special, "Is_Static_Expression", True); - Set (Special, "Left_Opnd", True); - Set (Special, "Must_Check_Expr", True); - Set (Special, "No_Overflow_Expr", True); - Set (Special, "Paren_Count", True); - Set (Special, "Raises_Constraint_Error", True); - Set (Special, "Right_Opnd", True); - - -- Read template header and generate new header - - loop - Line := Get_Line (InT); - - -- Skip lines describing the template - - if Match (Line, "-- This file is a template") then - loop - Line := Get_Line (InT); - exit when Line = ""; - end loop; - end if; - - exit when Match (Line, "package"); - - if Match (Line, Is_Temp, M) then - Replace (M, A & " S p e c "); - end if; - - Put_Line (OutS, Line); - end loop; - - Put_Line (OutS, Line); - - -- Copy rest of comments up to template insert point to spec - - loop - Line := Get_Line (InT); - exit when Match (Line, "!!TEMPLATE INSERTION POINT"); - Put_Line (OutS, Line); - end loop; - - -- Here we are doing the actual insertions - - Put_Line (OutS, " Pchars : constant String :="); - - -- Loop through comments describing nodes, picking up fields - - loop - Line := Get_Line (InS); - Lineno := Lineno + 1; - exit when Match (Line, " type Node_Kind"); - - if Match (Line, Get_Node) - and then not Match (Node, Tst_Punc) - then - Outstring := Node & ' '; - - loop - Line := Get_Line (InS); - exit when Line = ""; - - if Match (Line, Get_Syn) - and then not Match (Synonym, "plus") - and then not Present (Special, Synonym) - then - -- Convert this field into the character used to - -- represent the field according to the table: - - -- Field1 '#' - -- Field2 '$' - -- Field3 '%' - -- Field4 '&' - -- Field5 "'" - -- Flag4 '+' - -- Flag5 ',' - -- Flag6 '-' - -- Flag7 '.' - -- Flag8 '/' - -- Flag9 '0' - -- Flag10 '1' - -- Flag11 '2' - -- Flag12 '3' - -- Flag13 '4' - -- Flag14 '5' - -- Flag15 '6' - -- Flag16 '7' - -- Flag17 '8' - -- Flag18 '9' - - if Match (Field, Brk_Min) then - Field := Ffield; - end if; - - if Match (Field, Is_Flag) then - Fieldch := Char (Flag_Base - 1 + N (Flagno)); - - elsif Match (Field, Is_Field) then - Fieldch := Char (Field_Base - 1 + N (Fieldno)); - - else - Put_Line - (Standard_Error, - "*** Line " & - Lineno & - " has unrecognized field name " & - Field); - raise Err; - end if; - - Append (Outstring, Fieldch & Synonym); - end if; - end loop; - - Set (Strings, Node, Outstring); - end if; - end loop; - - -- Loop through actual definitions of node kind enumeration literals - - loop - loop - Line := Get_Line (InS); - Lineno := Lineno + 1; - exit when Match (Line, Is_Syn); - end loop; - - S := Get (Strings, Syn); - Match (S, Brk_Node, ""); - Count := Count + 1; - Names (Count) := Syn; - Positions (Count) := Curpos; - Curpos := Curpos + Length (S); - Put_Line (OutS, " -- " & Node); - Prefix := V (" "); - exit when Term = ")"; - - -- Loop to output the string literal for Pchars - - loop - Sp := 79 - 4 - Length (Prefix); - exit when Size (S) <= Sp; - Match (S, Chop_SP, ""); - Put_Line (OutS, Prefix & '"' & S1 & """ &"); - Prefix := V (" "); - end loop; - - Put_Line (OutS, Prefix & '"' & S & """ &"); - end loop; - - Put_Line (OutS, " """";"); - Put_Line (OutS, ""); - Put_Line - (OutS, " type Pchar_Pos_Array is array (Node_Kind) of Positive;"); - Put_Line - (OutS, - " Pchar_Pos : constant Pchar_Pos_Array := Pchar_Pos_Array'("); - - -- Output lines for Pchar_Pos_Array values - - for M in 1 .. Count - 1 loop - Name := Rpad ("N_" & Names (M), 40); - Put_Line (OutS, " " & Name & " => " & Positions (M) & ','); - end loop; - - Name := Rpad ("N_" & Names (Count), 40); - Put_Line (OutS, " " & Name & " => " & Positions (Count) & ");"); - - Put_Line (OutS, ""); - Put_Line (OutS, "end Treeprs;"); - -exception - when Err => - Put_Line (Standard_Error, "*** fatal error"); - Set_Exit_Status (1); - -end XTreeprs; diff --git a/gnattools/Makefile.in b/gnattools/Makefile.in index b0860eaf96d..055a2693f49 100644 --- a/gnattools/Makefile.in +++ b/gnattools/Makefile.in @@ -170,14 +170,18 @@ $(GCC_DIR)/stamp-gnatlib-rts: fi -# Build directory for the tools. Let's copy the target-dependent -# sources using the same mechanism as for gnatlib. The other sources are -# accessed using the vpath directive in ada/Makefile.in +# Build directory for the tools. We first need to copy the generated files, +# then the target-dependent sources using the same mechanism as for gnatlib. + +GENERATED_FILES_FOR_TOOLS = \ + einfo-entities.ads einfo-entities.adb sdefault.adb seinfo.ads \ + sinfo-nodes.ads sinfo-nodes.adb snames.ads snames.adb $(GCC_DIR)/stamp-tools: -rm -rf $(GCC_DIR)/ada/tools -mkdir -p $(GCC_DIR)/ada/tools - -(cd $(GCC_DIR)/ada/tools; $(LN_S) ../sdefault.adb ../snames.ads ../snames.adb .) + -(cd $(GCC_DIR)/ada/tools; $(foreach FILE,$(GENERATED_FILES_FOR_TOOLS), \ + $(LN_S) ../$(FILE) $(FILE);)) -$(foreach PAIR,$(TOOLS_TARGET_PAIRS), \ rm -f $(GCC_DIR)/ada/tools/$(word 1,$(subst <, ,$(PAIR)));\ $(LN_S) $(fsrcdir)/ada/$(word 2,$(subst <, ,$(PAIR))) \ |