# 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
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
$(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
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;
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;
------------------------------------------------------------------------------
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;
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;
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;
-- --
------------------------------------------------------------------------------
-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
-- 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
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 --
--------------------------------------------------
-- 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;
-- 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
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 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);
+ 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.
- return New_Id;
- end Allocate_New_Node;
+ function Off_0 (N : Node_Id) return Node_Offset;
+ -- Offset of the first slot of N (offset 0) in Slots.Table
- --------------
- -- Analyzed --
- --------------
+ function Off_L (N : Node_Id) return Node_Offset;
+ -- Offset of the last slot of N in Slots.Table
- function Analyzed (N : Node_Id) return Boolean is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Analyzed;
- end Analyzed;
+ procedure Zero_Slots (F, L : Node_Offset) with Inline;
+ -- Set slots in the range F..L to zero
- --------------------------
- -- Basic_Set_Convention --
- --------------------------
+ procedure Zero_Slots (N : Node_Or_Entity_Id) with Inline;
+ -- Zero the slots belonging to N
- procedure Basic_Set_Convention (E : Entity_Id; Val : Convention_Id) 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;
+ procedure Copy_Slots (From, To, Num_Slots : Node_Offset) with Inline;
+ -- Copy Num_Slots slots from From to To
- -------------------
- -- Check_Actuals --
- -------------------
+ procedure Copy_Slots (Source, Destination : Node_Id) with Inline;
+ -- Copies the slots of Source to Destination
- function Check_Actuals (N : Node_Id) return Boolean is
- begin
- return Flags.Table (N).Check_Actuals;
- end Check_Actuals;
+ 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.
- --------------------------
- -- Check_Error_Detected --
- --------------------------
+ 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_Error_Detected is
- begin
- -- An anomaly has been detected which is assumed to be a consequence of
- -- a previous serious error or configurable run time violation. Raise
- -- an exception if no such error has been detected.
+ 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.
- if Serious_Errors_Detected = 0
- and then Configurable_Run_Time_Violations = 0
- then
- raise Program_Error;
- end if;
- end Check_Error_Detected;
+ 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
- -----------------
- -- Change_Node --
- -----------------
+ 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.
- procedure Change_Node (N : Node_Id; New_Node_Kind : Node_Kind) is
+ 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;
- -- Flags table attributes
+ package body Field_Checking is
- Save_CA : constant Boolean := Flags.Table (N).Check_Actuals;
- Save_Is_IGN : constant Boolean := Flags.Table (N).Is_Ignored_Ghost_Node;
+ -- Tables used by Field_Present
- -- Nodes table attributes
+ 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;
- 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);
+ 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;
- Par_Count : Nat := 0;
+ procedure Init_Tables;
- begin
- if Nkind (N) in N_Subexpr then
- Par_Count := Paren_Count (N);
- end if;
+ 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.
- 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;
+ --------------------
+ -- Fields_Present --
+ --------------------
- Flags.Table (N) := Default_Flags;
- Flags.Table (N).Check_Actuals := Save_CA;
- Flags.Table (N).Is_Ignored_Ghost_Node := Save_Is_IGN;
+ 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;
- if New_Node_Kind in N_Subexpr then
- Set_Paren_Count (N, Par_Count);
- end if;
- end Change_Node;
+ return Result;
+ end Fields_Present;
- -----------------------
- -- Comes_From_Source --
- -----------------------
+ 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;
- 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;
+ return Result;
+ end Fields_Present;
- ----------------
- -- Convention --
- ----------------
+ procedure Init_Tables is
+ begin
+ Node_Fields_Present := new Node_Field_Sets;
- 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;
+ for Kind in Node_Kind loop
+ Node_Fields_Present (Kind) := Fields_Present (Kind);
+ end loop;
- ---------------
- -- Copy_Node --
- ---------------
+ Entity_Fields_Present := new Entity_Field_Sets;
- 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;
+ for Kind in Entity_Kind loop
+ Entity_Fields_Present (Kind) := Fields_Present (Kind);
+ end loop;
+ end Init_Tables;
- begin
- pragma Debug (New_Node_Debugging_Output (Source));
- pragma Debug (New_Node_Debugging_Output (Destination));
+ -- In production mode, we leave Node_Fields_Present and
+ -- Entity_Fields_Present null. Field_Present is only for
+ -- use in assertions.
- Nodes.Table (Destination) := Nodes.Table (Source);
- Nodes.Table (Destination).In_List := Save_In_List;
- Nodes.Table (Destination).Link := Save_Link;
+ pragma Debug (Init_Tables);
- Flags.Table (Destination) := Flags.Table (Source);
+ function Field_Present
+ (Kind : Node_Kind; Field : Node_Field) return Boolean is
+ begin
+ if Node_Fields_Present = null then
+ return True;
+ end if;
- Set_Paren_Count_Of_Copy (Target => Destination, Source => Source);
+ return Node_Fields_Present (Kind) (Field);
+ end Field_Present;
- -- Deal with copying extension nodes if present. No need to copy flags
- -- table entries, since they are always zero for extending components.
+ function Field_Present
+ (Kind : Entity_Kind; Field : Entity_Field) return Boolean is
+ begin
+ if Entity_Fields_Present = null then
+ return True;
+ end if;
- pragma Assert (Has_Extension (Source) = Has_Extension (Destination));
+ return Entity_Fields_Present (Kind) (Field);
+ end Field_Present;
- if Has_Extension (Source) then
- for J in 1 .. Num_Extension_Nodes loop
- Nodes.Table (Destination + J) := Nodes.Table (Source + J);
- end loop;
- end if;
- end Copy_Node;
+ end Field_Checking;
------------------------
- -- Copy_Separate_List --
+ -- Atree_Private_Part --
------------------------
- function Copy_Separate_List (Source : List_Id) return List_Id is
- Result : constant List_Id := New_List;
- Nod : Node_Id;
-
- begin
- Nod := First (Source);
- while Present (Nod) loop
- Append (Copy_Separate_Tree (Nod), Result);
- Next (Nod);
- end loop;
+ 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;
- return Result;
- end Copy_Separate_List;
+ 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;
- ------------------------
- -- Copy_Separate_Tree --
- ------------------------
+ pragma Debug (Validate_Node_Write (N));
+ pragma Assert (Offset'Valid);
+ pragma Assert (Offset < Size_In_Slots (N));
- function Copy_Separate_Tree (Source : Node_Id) return Node_Id is
- New_Id : Node_Id;
+ Enable_Validate_Node_And_Offset_Write := True;
+ end if;
+ end Validate_Node_And_Offset_Write;
- function Copy_Entity (E : Entity_Id) return Entity_Id;
- -- Copy Entity, copying only the Ekind and Chars fields
+ procedure Validate_Node (N : Node_Or_Entity_Id) is
+ begin
+ if Enable_Validate_Node then
+ Enable_Validate_Node := False;
- function Copy_List (List : List_Id) return List_Id;
- -- Copy list
+ 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);
- function Possible_Copy (Field : Union_Id) return Union_Id;
- -- Given a field, returns a copy of the node or list if its parent is
- -- the current source node, and otherwise returns the input.
+ if Nkind (N) in N_Entity then
+ pragma Assert (Ekind (N)'Valid);
+ end if;
- -----------------
- -- Copy_Entity --
- -----------------
+ 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;
- function Copy_Entity (E : Entity_Id) return Entity_Id is
- New_Ent : Entity_Id;
+ Enable_Validate_Node := True;
+ end if;
+ end Validate_Node;
+ procedure Validate_Node_Write (N : Node_Or_Entity_Id) is
begin
- -- Build appropriate node
+ if Enable_Validate_Node_Write then
+ Enable_Validate_Node_Write := False;
- case N_Entity (Nkind (E)) is
- when N_Defining_Identifier =>
- New_Ent := New_Entity (N_Defining_Identifier, Sloc (E));
+ pragma Debug (Validate_Node (N));
+ pragma Assert (not Locked);
- when N_Defining_Character_Literal =>
- New_Ent := New_Entity (N_Defining_Character_Literal, Sloc (E));
+ Enable_Validate_Node_Write := True;
+ end if;
+ end Validate_Node_Write;
- when N_Defining_Operator_Symbol =>
- New_Ent := New_Entity (N_Defining_Operator_Symbol, Sloc (E));
- end case;
+ function Is_Valid_Node (U : Union_Id) return Boolean is
+ begin
+ return Node_Id'Base (U) <= Node_Offsets.Last;
+ end Is_Valid_Node;
- Set_Chars (New_Ent, Chars (E));
- -- Set_Comes_From_Source (New_Ent, Comes_From_Source (E));
- return New_Ent;
- end Copy_Entity;
+ function Alloc_Node_Id return Node_Id is
+ begin
+ Node_Offsets.Increment_Last;
+ return Node_Offsets.Last;
+ end Alloc_Node_Id;
- ---------------
- -- Copy_List --
- ---------------
+ 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 Copy_List (List : List_Id) return List_Id is
- NL : List_Id;
- E : Node_Id;
+ 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
- if List = No_List then
- return No_List;
+ return Cast (Get_1_Bit_Val (N, Offset));
+ end Get_1_Bit_Field;
- else
- NL := New_List;
-
- E := First (List);
- while Present (E) loop
- if Has_Extension (E) then
- Append (Copy_Entity (E), NL);
- else
- Append (Copy_Separate_Tree (E), NL);
- end if;
+ function Get_2_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
+ is
+ pragma Assert (Field_Type'Size = 2);
- Next (E);
- end loop;
+ 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;
- return NL;
- end if;
- end Copy_List;
+ function Get_4_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
+ is
+ pragma Assert (Field_Type'Size = 4);
- -------------------
- -- Possible_Copy --
- -------------------
+ 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 Possible_Copy (Field : Union_Id) return Union_Id is
- New_N : Union_Id;
+ 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
- if Field in Node_Range then
- New_N := Union_Id (Copy_Separate_Tree (Node_Id (Field)));
-
- if Parent (Node_Id (Field)) = Source then
- Set_Parent (Node_Id (New_N), New_Id);
- end if;
+ return Cast (Get_8_Bit_Val (N, Offset));
+ end Get_8_Bit_Field;
- return New_N;
+ function Get_32_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
+ is
+ pragma Assert (Field_Type'Size = 32);
- elsif Field in List_Range then
- New_N := Union_Id (Copy_List (List_Id (Field)));
+ 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;
- if Parent (List_Id (Field)) = Source then
- Set_Parent (List_Id (New_N), New_Id);
- end if;
+ 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.
- return New_N;
+ if Get_32_Bit_Val (N, Offset) = 0 then
+ return Default_Val;
else
- return Field;
+ return Get_Field (N, Offset);
end if;
- end Possible_Copy;
+ end Get_32_Bit_Field_With_Default;
- -- Start of processing for Copy_Separate_Tree
+ procedure Set_1_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
+ is
+ pragma Assert (Field_Type'Size = 1);
- begin
- if Source <= Empty_Or_Error then
- return Source;
+ 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;
- elsif Has_Extension (Source) then
- return Copy_Entity (Source);
+ procedure Set_2_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
+ is
+ pragma Assert (Field_Type'Size = 2);
- else
- New_Id := New_Copy (Source);
+ 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;
- -- Recursively copy descendants
+ procedure Set_4_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
+ is
+ pragma Assert (Field_Type'Size = 4);
- 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)));
+ 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;
- -- Explicitly copy the aspect specifications as those do not reside
- -- in a node field.
+ procedure Set_8_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
+ is
+ pragma Assert (Field_Type'Size = 8);
- if Permits_Aspect_Specifications (Source)
- and then Has_Aspects (Source)
- then
- Set_Aspect_Specifications
- (New_Id, Copy_List (Aspect_Specifications (Source)));
- end if;
+ 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;
- -- Set Entity field to Empty to ensure that no entity references
- -- are shared between the two, if the source is already analyzed.
+ procedure Set_32_Bit_Field
+ (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
+ is
+ pragma Assert (Field_Type'Size = 32);
- if Nkind (New_Id) in N_Has_Entity
- or else Nkind (New_Id) = N_Freeze_Entity
- then
- Set_Entity (New_Id, Empty);
- end if;
+ 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;
- -- Reset all Etype fields and Analyzed flags, because input tree may
- -- have been fully or partially analyzed.
+ 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;
- if Nkind (New_Id) in N_Has_Etype then
- Set_Etype (New_Id, Empty);
- end if;
+ 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;
- Set_Analyzed (New_Id, False);
+ 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;
- -- Rather special case, if we have an expanded name, then change
- -- it back into a selected component, so that the tree looks the
- -- way it did coming out of the parser. This will change back
- -- when we analyze the selected component node.
+ function Get_8_Bit_Val
+ (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_8_Bit
+ is
+ L : constant Field_Offset := 4;
- if Nkind (New_Id) = N_Expanded_Name then
+ pragma Debug (Validate_Node_And_Offset (N, Offset / L));
- -- The following code is a bit kludgy. It would be cleaner to
- -- Add an entry Change_Expanded_Name_To_Selected_Component to
- -- Sinfo.CN, but that's delicate because Atree is used in the
- -- binder, so we don't want to add that dependency.
- -- ??? Revisit now that ASIS is no longer using this unit.
+ 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;
- -- 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.
+ 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));
- -- Change the node type
+ S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset);
+ begin
+ return S.Slot_32;
+ end Get_32_Bit_Val;
- Atree.Unchecked_Access.Set_Nkind (New_Id, N_Selected_Component);
+ 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;
- -- Clear the Chars field which is not present in a selected
- -- component node, so we don't want a junk value around.
+ 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;
- Set_Node1 (New_Id, Empty);
- end if;
+ 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;
- -- All done, return copied node
+ procedure Set_8_Bit_Val
+ (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_8_Bit)
+ is
+ L : constant Field_Offset := 4;
- return New_Id;
- end if;
- end Copy_Separate_Tree;
+ pragma Debug (Validate_Node_And_Offset_Write (N, Offset / L));
- -----------
- -- Ekind --
- -----------
+ 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 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;
+ 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;
- ------------------
- -- Error_Posted --
- ------------------
+ 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);
- function Error_Posted (N : Node_Id) return Boolean is
begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Error_Posted;
- end Error_Posted;
+ 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;
- -----------------------
- -- Exchange_Entities --
- -----------------------
+ procedure Reinit_Field_To_Zero (N : Node_Id; Field : Node_Field) is
+ begin
+ Set_Field_Value (N, Field, 0);
+ end Reinit_Field_To_Zero;
- procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id) is
- Temp_Ent : Node_Record;
- Temp_Flg : Flags_Byte;
+ 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 Reinit_Field_To_Zero
+ (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind_Set) is
begin
- pragma Debug (New_Node_Debugging_Output (E1));
- pragma Debug (New_Node_Debugging_Output (E2));
+ pragma Assert (Old_Ekind (Ekind (N)), "Reinit: " & Ekind (N)'Img);
+ Reinit_Field_To_Zero (N, Field);
+ end Reinit_Field_To_Zero;
- 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);
+ 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;
- -- Exchange the contents of the two entities
+ procedure Check_Vanishing_Fields
+ (Old_N : Node_Id; New_Kind : Node_Kind)
+ is
+ Old_Kind : constant Node_Kind := Nkind (Old_N);
- 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;
+ -- If this fails, it means you need to call Reinit_Field_To_Zero before
+ -- calling Set_Nkind.
- -- Exchange flag bytes for first component. No need to do the exchange
- -- for the other components, since the flag bytes are always zero.
+ begin
+ 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;
- Temp_Flg := Flags.Table (E1);
- Flags.Table (E1) := Flags.Table (E2);
- Flags.Table (E2) := Temp_Flg;
+ raise Program_Error;
+ end if;
+ end if;
+ end;
+ end loop;
+ end Check_Vanishing_Fields;
- -- That exchange exchanged the parent pointers as well, which is what
- -- we want, but we need to patch up the defining identifier pointers
- -- in the parent nodes (the child pointers) to match this switch
- -- unless for Implicit types entities which have no parent, in which
- -- case we don't do anything otherwise we won't be able to revert back
- -- to the original situation.
+ 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;
- -- Shouldn't this use Is_Itype instead of the Parent test
+ 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;
- if Present (Parent (E1)) and then Present (Parent (E2)) then
- Set_Defining_Identifier (Parent (E1), E1);
- Set_Defining_Identifier (Parent (E2), E2);
- end if;
- end Exchange_Entities;
+ procedure Reinit_Field_To_Zero (N : Node_Id; Field : Entity_Field) is
+ begin
+ Set_Field_Value (N, Field, 0);
+ end Reinit_Field_To_Zero;
- -----------------
- -- Extend_Node --
- -----------------
+ 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;
- function Extend_Node (Source : Node_Id) return Entity_Id is
- pragma Assert (Present (Source));
- pragma Assert (not Has_Extension (Source));
- New_Id : Entity_Id;
+ procedure Check_Vanishing_Fields
+ (Old_N : Entity_Id; New_Kind : Entity_Kind)
+ is
+ Old_Kind : constant Entity_Kind := Ekind (Old_N);
- procedure Debug_Extend_Node;
- pragma Inline (Debug_Extend_Node);
- -- Debug routine for -gnatdn
+ -- If this fails, it means you need to call Reinit_Field_To_Zero before
+ -- calling Set_Ekind.
- -----------------------
- -- Debug_Extend_Node --
- -----------------------
+ 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;
- procedure Debug_Extend_Node is
- begin
- if Debug_Flag_N then
- Write_Str ("Extend node ");
- Write_Int (Int (Source));
+ pragma Assert (New_Kind = E_Void or else Old_Kind = E_Void);
- if New_Id = Source then
- Write_Str (" in place");
- else
- Write_Str (" copied to ");
- Write_Int (Int (New_Id));
+ raise Program_Error;
+ end if;
end if;
+ end;
+ end loop;
+ end Check_Vanishing_Fields;
- -- Write_Eol;
- end if;
- end Debug_Extend_Node;
+ Nkind_Offset : constant Field_Offset :=
+ Node_Field_Descriptors (Nkind).Offset;
- -- Start of processing for Extend_Node
+ 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
- -- 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_Nkind_Type (N, Nkind_Offset, Val);
+ end Init_Nkind;
- -- Set extension nodes
+ 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);
- for J in 1 .. Num_Extension_Nodes loop
- Nodes.Append (Default_Node_Extension);
- Flags.Append (Default_Flags);
- end loop;
+ 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));
- Orig_Nodes.Set_Last (Nodes.Last);
- Allocate_List_Tables (Nodes.Last);
- Report (Target => New_Id, Source => Source);
+ -- Grow the slots if necessary
- pragma Debug (Debug_Extend_Node);
+ 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);
- return New_Id;
- end Extend_Node;
+ 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;
- -----------------
- -- Fix_Parents --
- -----------------
+ Zero_Slots (Off_0 (N) + Old_Size, Slots.Last);
+ end if;
- procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id) is
- pragma Assert (Nkind (Ref_Node) = Nkind (Fix_Node));
+ Set_Nkind_Type (N, Nkind_Offset, Val);
+ pragma Debug (Validate_Node_Write (N));
+ end Mutate_Nkind;
- procedure Fix_Parent (Field : Union_Id);
- -- Fix up one parent pointer. Field is checked to see if it points to
- -- a node, list, or element list that has a parent that points to
- -- Ref_Node. If so, the parent is reset to point to Fix_Node.
+ Ekind_Offset : constant Field_Offset :=
+ Entity_Field_Descriptors (Ekind).Offset;
- ----------------
- -- Fix_Parent --
- ----------------
+ procedure Set_Ekind_Type is new Set_8_Bit_Field (Entity_Kind) with Inline;
- procedure Fix_Parent (Field : Union_Id) is
- begin
- -- Fix parent of node that is referenced by Field. Note that we must
- -- exclude the case where the node is a member of a list, because in
- -- this case the parent is the parent of the list.
+ procedure Set_Ekind
+ (N : Entity_Id; Val : Entity_Kind)
+ is
+ begin
+ if Ekind (N) = Val then
+ return;
+ end if;
- if Field in Node_Range
- and then Present (Node_Id (Field))
- and then not Nodes.Table (Node_Id (Field)).In_List
- and then Parent (Node_Id (Field)) = Ref_Node
- then
- Set_Parent (Node_Id (Field), Fix_Node);
+ if Debug_Flag_Underscore_V then
+ pragma Debug (Check_Vanishing_Fields (N, Val));
+ end if;
- -- Fix parent of list that is referenced by Field
+ -- For now, we are allocating all entities with the same size, so we
+ -- don't need to reallocate slots here.
- elsif Field in List_Range
- and then Present (List_Id (Field))
- and then Parent (List_Id (Field)) = Ref_Node
- then
- Set_Parent (List_Id (Field), Fix_Node);
- end if;
- end Fix_Parent;
+ Set_Ekind_Type (N, Ekind_Offset, Val);
+ pragma Debug (Validate_Node_Write (N));
+ end Set_Ekind;
- -- Start of processing for Fix_Parents
+ -----------------------
+ -- Allocate_New_Node --
+ -----------------------
+ function Allocate_New_Node (Kind : Node_Kind) return Node_Id is
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));
- end Fix_Parents;
+ 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;
- -------------------
- -- Flags_Address --
- -------------------
+ Init_Nkind (Result, Kind);
- function Flags_Address return System.Address is
- begin
- return Flags.Table (First_Node_Id)'Address;
- end Flags_Address;
+ 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;
- -----------------------------------
- -- Get_Comes_From_Source_Default --
- -----------------------------------
+ --------------------------
+ -- Check_Error_Detected --
+ --------------------------
- function Get_Comes_From_Source_Default return Boolean is
+ procedure Check_Error_Detected is
begin
- return Comes_From_Source_Default;
- end Get_Comes_From_Source_Default;
+ -- An anomaly has been detected which is assumed to be a consequence of
+ -- a previous serious error or configurable run time violation. Raise
+ -- an exception if no such error has been detected.
+
+ if Serious_Errors_Detected = 0
+ and then Configurable_Run_Time_Violations = 0
+ then
+ raise Program_Error;
+ end if;
+ end Check_Error_Detected;
-----------------
- -- Has_Aspects --
+ -- Change_Node --
-----------------
- function Has_Aspects (N : Node_Id) return Boolean is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Has_Aspects;
- end Has_Aspects;
+ 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);
- -------------------
- -- Has_Extension --
- -------------------
+ Old_Size : constant Field_Offset := Size_In_Slots (N);
+ New_Size : constant Field_Offset := Size_In_Slots_To_Alloc (New_Kind);
+
+ 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;
- function Has_Extension (N : Node_Id) return Boolean is
begin
- return N < Nodes.Last and then Nodes.Table (N + 1).Is_Extension;
- end Has_Extension;
+ if Nkind (N) in N_Subexpr then
+ Par_Count := Paren_Count (N);
+ end if;
- ----------------
- -- Initialize --
- ----------------
+ if New_Size > Old_Size then
+ pragma Debug (Zero_Slots (N));
+ Node_Offsets.Table (N) := Alloc_Slots (New_Size);
+ end if;
- procedure Initialize is
- Dummy : Node_Id;
- pragma Warnings (Off, Dummy);
+ Zero_Slots (N);
- begin
- Atree_Private_Part.Nodes.Init;
- Atree_Private_Part.Flags.Init;
- Orig_Nodes.Init;
- Paren_Counts.Init;
+ Mutate_Nkind (N, New_Kind);
- -- Allocate Empty node
+ 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);
- Dummy := New_Node (N_Empty, No_Location);
- Set_Name1 (Empty, No_Name);
+ if New_Kind in N_Subexpr then
+ Set_Paren_Count (N, Par_Count);
+ end if;
+ end Change_Node;
- -- Allocate Error node, and set Error_Posted, since we certainly
- -- only generate an Error node if we do post some kind of error.
+ ---------------
+ -- Copy_Node --
+ ---------------
- Dummy := New_Node (N_Error, No_Location);
- Set_Name1 (Error, Error_Name);
- Set_Error_Posted (Error, True);
- end Initialize;
+ procedure Copy_Slots (From, To, Num_Slots : Node_Offset) is
+ pragma Assert (From /= To);
- ---------------------------
- -- Is_Ignored_Ghost_Node --
- ---------------------------
+ All_Slots : Slots.Table_Type renames
+ Slots.Table (Slots.First .. Slots.Last);
- 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;
+ Source_Slots : Slots.Table_Type renames
+ All_Slots (From .. From + Num_Slots - 1);
- --------------------------
- -- Is_Rewrite_Insertion --
- --------------------------
+ Destination_Slots : Slots.Table_Type renames
+ All_Slots (To .. To + Num_Slots - 1);
- function Is_Rewrite_Insertion (Node : Node_Id) return Boolean is
begin
- return Nodes.Table (Node).Rewrite_Ins;
- end Is_Rewrite_Insertion;
+ Destination_Slots := Source_Slots;
+ end Copy_Slots;
- -----------------------------
- -- Is_Rewrite_Substitution --
- -----------------------------
+ procedure Copy_Slots (Source, Destination : Node_Id) is
+ pragma Debug (Validate_Node (Source));
+ pragma Debug (Validate_Node_Write (Destination));
+ pragma Assert (Source /= Destination);
- function Is_Rewrite_Substitution (Node : Node_Id) return Boolean is
- begin
- return Orig_Nodes.Table (Node) /= Node;
- end Is_Rewrite_Substitution;
+ S_Size : constant Field_Offset := Size_In_Slots (Source);
- ------------------
- -- Last_Node_Id --
- ------------------
+ All_Node_Offsets : Node_Offsets.Table_Type renames
+ Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last);
- function Last_Node_Id return Node_Id is
begin
- return Nodes.Last;
- end Last_Node_Id;
+ Copy_Slots
+ (All_Node_Offsets (Source), All_Node_Offsets (Destination), S_Size);
+ end Copy_Slots;
- ----------
- -- Lock --
- ----------
+ ---------------
+ -- Copy_Node --
+ ---------------
- 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;
+ procedure Copy_Node (Source, Destination : Node_Or_Entity_Id) is
+ pragma Debug (New_Node_Debugging_Output (Source));
+ pragma Debug (New_Node_Debugging_Output (Destination));
- ----------------
- -- Lock_Nodes --
- ----------------
+ pragma Assert (Source /= Destination);
- procedure Lock_Nodes is
- begin
- pragma Assert (not Locked);
- Locked := True;
- end Lock_Nodes;
+ Save_In_List : constant Boolean := In_List (Destination);
+ Save_Link : constant Union_Id := Link (Destination);
- -------------------------
- -- Mark_New_Ghost_Node --
- -------------------------
+ S_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Source);
+ D_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Destination);
- procedure Mark_New_Ghost_Node (N : Node_Or_Entity_Id) is
begin
- -- The Ghost node is created within a Ghost region
+ -- 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.
- if Ghost_Mode = Check then
- if Nkind (N) in N_Entity then
- Set_Is_Checked_Ghost_Entity (N);
- end if;
+ -- If Source doesn't fit in Destination, we need to allocate
- elsif Ghost_Mode = Ignore then
- if Nkind (N) in N_Entity then
- Set_Is_Ignored_Ghost_Entity (N);
- end if;
+ if D_Size < S_Size then
+ pragma Debug (Zero_Slots (Destination)); -- destroy old slots
+ Node_Offsets.Table (Destination) := Alloc_Slots (S_Size);
+ end if;
- Set_Is_Ignored_Ghost_Node (N);
+ Copy_Slots (Source, Destination);
- -- Record the ignored Ghost node or entity in order to eliminate it
- -- from the tree later.
+ Set_In_List (Destination, Save_In_List);
+ Set_Link (Destination, Save_Link);
- if Ignored_Ghost_Recording_Proc /= null then
- Ignored_Ghost_Recording_Proc.all (N);
- end if;
- end if;
- end Mark_New_Ghost_Node;
+ Set_Paren_Count_Of_Copy (Target => Destination, Source => Source);
+ end Copy_Node;
- ----------------------------
- -- Mark_Rewrite_Insertion --
- ----------------------------
+ ------------------------
+ -- Copy_Separate_List --
+ ------------------------
+
+ function Copy_Separate_List (Source : List_Id) return List_Id is
+ Result : constant List_Id := New_List;
+ Nod : Node_Id := First (Source);
- procedure Mark_Rewrite_Insertion (New_Node : Node_Id) is
begin
- Nodes.Table (New_Node).Rewrite_Ins := True;
- end Mark_Rewrite_Insertion;
+ while Present (Nod) loop
+ Append (Copy_Separate_Tree (Nod), Result);
+ Next (Nod);
+ end loop;
- --------------
- -- New_Copy --
- --------------
+ return Result;
+ end Copy_Separate_List;
- function New_Copy (Source : Node_Id) return Node_Id is
- New_Id : Node_Id;
- begin
- if Source <= Empty_Or_Error then
- return Source;
- end if;
+ ------------------------
+ -- Copy_Separate_Tree --
+ ------------------------
- Nodes.Append (Nodes.Table (Source));
- Flags.Append (Flags.Table (Source));
- New_Id := Nodes.Last;
- Orig_Nodes.Append (New_Id);
- Set_Check_Actuals (New_Id, False);
- Set_Paren_Count_Of_Copy (Target => New_Id, Source => Source);
+ function Copy_Separate_Tree (Source : Node_Id) return Node_Id is
- -- Set extension nodes if required
+ pragma Debug (Validate_Node (Source));
- 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;
+ New_Id : Node_Id;
- Allocate_List_Tables (Nodes.Last);
- Report (Target => New_Id, Source => Source);
+ function Copy_Entity (E : Entity_Id) return Entity_Id;
+ -- Copy Entity, copying only Chars field
- Nodes.Table (New_Id).In_List := False;
- Nodes.Table (New_Id).Link := Empty_List_Or_Node;
+ function Copy_List (List : List_Id) return List_Id;
+ -- Copy list
- -- If the original is marked as a rewrite insertion, then unmark the
- -- copy, since we inserted the original, not the copy.
+ function Possible_Copy (Field : Union_Id) return Union_Id;
+ -- Given a field, returns a copy of the node or list if its parent is
+ -- the current source node, and otherwise returns the input.
- Nodes.Table (New_Id).Rewrite_Ins := False;
- pragma Debug (New_Node_Debugging_Output (New_Id));
+ -----------------
+ -- Copy_Entity --
+ -----------------
- -- Clear Is_Overloaded since we cannot have semantic interpretations
- -- of this new node.
+ function Copy_Entity (E : Entity_Id) return Entity_Id is
+ begin
+ pragma Assert (Nkind (E) in N_Entity);
- if Nkind (Source) in N_Subexpr then
- Set_Is_Overloaded (New_Id, False);
- end if;
+ return Result : constant Entity_Id := New_Entity (Nkind (E), Sloc (E))
+ do
+ Set_Chars (Result, Chars (E));
+ end return;
+ end Copy_Entity;
- -- Always clear Has_Aspects, the caller must take care of copying
- -- aspects if this is required for the particular situation.
+ ---------------
+ -- Copy_List --
+ ---------------
- Set_Has_Aspects (New_Id, False);
+ function Copy_List (List : List_Id) return List_Id is
+ NL : List_Id;
+ E : Node_Id;
- -- Mark the copy as Ghost depending on the current Ghost region
+ begin
+ if List = No_List then
+ return No_List;
- Mark_New_Ghost_Node (New_Id);
+ else
+ NL := New_List;
- pragma Assert (New_Id /= Source);
- return New_Id;
- end New_Copy;
+ E := First (List);
+ while Present (E) loop
+ if Is_Entity (E) then
+ Append (Copy_Entity (E), NL);
+ else
+ Append (Copy_Separate_Tree (E), NL);
+ end if;
- ----------------
- -- New_Entity --
- ----------------
+ Next (E);
+ end loop;
- function New_Entity
- (New_Node_Kind : Node_Kind;
- New_Sloc : Source_Ptr) return Entity_Id
- is
- pragma Assert (New_Node_Kind in N_Entity);
- New_Id : constant Entity_Id := Allocate_New_Node;
- begin
- -- Set extension nodes
+ return NL;
+ end if;
+ end Copy_List;
- for J in 1 .. Num_Extension_Nodes loop
- Nodes.Append (Default_Node_Extension);
- Flags.Append (Default_Flags);
- end loop;
+ -------------------
+ -- Possible_Copy --
+ -------------------
- Orig_Nodes.Set_Last (Nodes.Last);
+ function Possible_Copy (Field : Union_Id) return Union_Id is
+ New_N : Union_Id;
- -- 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.
+ begin
+ if Field in Node_Range then
+ New_N := Union_Id (Copy_Separate_Tree (Node_Id (Field)));
- if New_Sloc > No_Location and then Comes_From_Source_Default then
- Current_Error_Node := New_Id;
- end if;
+ if Parent (Node_Id (Field)) = Source then
+ Set_Parent (Node_Id (New_N), New_Id);
+ end if;
- Nodes.Table (New_Id).Nkind := New_Node_Kind;
- Nodes.Table (New_Id).Sloc := New_Sloc;
- pragma Debug (New_Node_Debugging_Output (New_Id));
+ return New_N;
- -- Mark the new entity as Ghost depending on the current Ghost region
+ elsif Field in List_Range then
+ New_N := Union_Id (Copy_List (List_Id (Field)));
- Mark_New_Ghost_Node (New_Id);
+ if Parent (List_Id (Field)) = Source then
+ Set_Parent (List_Id (New_N), New_Id);
+ end if;
- return New_Id;
- end New_Entity;
+ return New_N;
- --------------
- -- New_Node --
- --------------
+ else
+ return Field;
+ end if;
+ end Possible_Copy;
- function New_Node
- (New_Node_Kind : Node_Kind;
- 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);
- begin
- Nodes.Table (New_Id).Nkind := New_Node_Kind;
- Nodes.Table (New_Id).Sloc := New_Sloc;
- pragma Debug (New_Node_Debugging_Output (New_Id));
+ procedure Walk is new Walk_Sinfo_Fields_Pairwise (Possible_Copy);
- -- 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 an error location for the bomb.
+ -- Start of processing for Copy_Separate_Tree
- if Comes_From_Source_Default and then New_Sloc > No_Location then
- Current_Error_Node := New_Id;
- end if;
+ begin
+ if Source <= Empty_Or_Error then
+ return Source;
- -- Mark the new node as Ghost depending on the current Ghost region
+ elsif Is_Entity (Source) then
+ return Copy_Entity (Source);
- Mark_New_Ghost_Node (New_Id);
+ else
+ New_Id := New_Copy (Source);
- return New_Id;
- end New_Node;
+ Walk (New_Id, Source);
- -------------------------
- -- New_Node_Breakpoint --
- -------------------------
+ -- Explicitly copy the aspect specifications as those do not reside
+ -- in a node field.
- procedure nn is
- begin
- Write_Str ("Watched node ");
- Write_Int (Int (Watch_Node));
- Write_Eol;
- end nn;
+ if Permits_Aspect_Specifications (Source)
+ and then Has_Aspects (Source)
+ then
+ Set_Aspect_Specifications
+ (New_Id, Copy_List (Aspect_Specifications (Source)));
+ end if;
- -------------------------------
- -- New_Node_Debugging_Output --
- -------------------------------
+ -- Set Entity field to Empty to ensure that no entity references
+ -- are shared between the two, if the source is already analyzed.
- procedure nnd (N : Node_Id) is
- Node_Is_Watched : constant Boolean := N = Watch_Node;
+ if Nkind (New_Id) in N_Has_Entity
+ or else Nkind (New_Id) = N_Freeze_Entity
+ then
+ Set_Entity (New_Id, Empty);
+ end if;
- begin
- if Debug_Flag_N or else Node_Is_Watched then
- Node_Debug_Output ("Node", N);
+ -- Reset all Etype fields and Analyzed flags, because input tree may
+ -- have been fully or partially analyzed.
- if Node_Is_Watched then
- New_Node_Breakpoint;
+ if Nkind (New_Id) in N_Has_Etype then
+ Set_Etype (New_Id, Empty);
end if;
- end if;
- end nnd;
- -----------
- -- Nkind --
- -----------
+ Set_Analyzed (New_Id, False);
- function Nkind (N : Node_Id) return Node_Kind is
- begin
- return Nodes.Table (N).Nkind;
- end Nkind;
+ -- Rather special case, if we have an expanded name, then change
+ -- it back into a selected component, so that the tree looks the
+ -- way it did coming out of the parser. This will change back
+ -- when we analyze the selected component node.
- --------
- -- No --
- --------
+ if Nkind (New_Id) = N_Expanded_Name then
- function No (N : Node_Id) return Boolean is
- begin
- return N = Empty;
- end No;
+ -- The following code is a bit kludgy. It would be cleaner to
+ -- Add an entry Change_Expanded_Name_To_Selected_Component to
+ -- Sinfo.CN, but that's delicate because Atree is used in the
+ -- binder, so we don't want to add that dependency.
+ -- ??? Revisit now that ASIS is no longer using this unit.
- -----------------------
- -- Node_Debug_Output --
- -----------------------
+ -- 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.
- procedure Node_Debug_Output (Op : String; N : Node_Id) is
- begin
- Write_Str (Op);
+ -- 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.
- if Nkind (N) in N_Entity then
- Write_Str (" entity");
- else
- Write_Str (" node");
- end if;
+ 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);
- Write_Str (" Id = ");
- Write_Int (Int (N));
- Write_Str (" ");
- Write_Location (Sloc (N));
- Write_Str (" ");
- Write_Str (Node_Kind'Image (Nkind (N)));
- Write_Eol;
- end Node_Debug_Output;
+ -- Change the node type
- -------------------
- -- Nodes_Address --
- -------------------
+ Mutate_Nkind (New_Id, N_Selected_Component);
+ end if;
- function Nodes_Address return System.Address is
- begin
- return Nodes.Table (First_Node_Id)'Address;
- end Nodes_Address;
+ -- All done, return copied node
- -----------------------------------
- -- Approx_Num_Nodes_And_Entities --
- -----------------------------------
+ return New_Id;
+ end if;
+ end Copy_Separate_Tree;
- 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".
+ -----------------------
+ -- Exchange_Entities --
+ -----------------------
- return Nat (Nodes.Last - First_Node_Id);
- end Approx_Num_Nodes_And_Entities;
+ procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id) is
+ pragma Debug (New_Node_Debugging_Output (E1));
+ pragma Debug (New_Node_Debugging_Output (E2));
- -------------------
- -- Original_Node --
- -------------------
+ 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));
+
+ Old_E1 : constant Node_Offset := Node_Offsets.Table (E1);
- function Original_Node (Node : Node_Id) return Node_Id is
begin
- return Orig_Nodes.Table (Node);
- end Original_Node;
+ 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
+ -- in the parent nodes (the child pointers) to match this switch
+ -- unless for Implicit types entities which have no parent, in which
+ -- 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???
+
+ if Present (Parent (E1)) and then Present (Parent (E2)) then
+ Set_Defining_Identifier (Parent (E1), E1);
+ Set_Defining_Identifier (Parent (E2), E2);
+ end if;
+ end Exchange_Entities;
-----------------
- -- Paren_Count --
+ -- Extend_Node --
-----------------
- function Paren_Count (N : Node_Id) return Nat is
- C : Nat := 0;
+ procedure Extend_Node (Source : Node_Id) is
+ pragma Assert (Present (Source));
+ 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
- pragma Assert (N <= Nodes.Last);
+ Set_Check_Actuals (Source, False);
+ Mutate_Nkind (Source, New_Kind);
+ Report (Target => Source, Source => Source);
+ end Extend_Node;
- if Nodes.Table (N).Pflag1 then
- C := C + 1;
- end if;
+ -----------------
+ -- Fix_Parents --
+ -----------------
- if Nodes.Table (N).Pflag2 then
- C := C + 2;
- end if;
+ procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id) is
+ pragma Assert (Nkind (Ref_Node) = Nkind (Fix_Node));
- -- Value of 0,1,2 returned as is
+ procedure Fix_Parent (Field : Union_Id);
+ -- Fix up one parent pointer. Field is checked to see if it points to
+ -- a node, list, or element list that has a parent that points to
+ -- Ref_Node. If so, the parent is reset to point to Fix_Node.
- if C <= 2 then
- return C;
+ ----------------
+ -- Fix_Parent --
+ ----------------
- -- Value of 3 means we search the table, and we must find an entry
+ procedure Fix_Parent (Field : Union_Id) is
+ begin
+ -- Fix parent of node that is referenced by Field. Note that we must
+ -- exclude the case where the node is a member of a list, because in
+ -- this case the parent is the parent of the list.
- else
- for J in Paren_Counts.First .. Paren_Counts.Last loop
- if N = Paren_Counts.Table (J).Nod then
- return Paren_Counts.Table (J).Count;
- end if;
- end loop;
+ if Field in Node_Range
+ and then Present (Node_Id (Field))
+ and then not In_List (Node_Id (Field))
+ and then Parent (Node_Id (Field)) = Ref_Node
+ then
+ Set_Parent (Node_Id (Field), Fix_Node);
- raise Program_Error;
- end if;
- end Paren_Count;
+ -- Fix parent of list that is referenced by Field
- ------------
- -- Parent --
- ------------
+ elsif Field in List_Range
+ and then Present (List_Id (Field))
+ and then Parent (List_Id (Field)) = Ref_Node
+ then
+ Set_Parent (List_Id (Field), Fix_Node);
+ end if;
+ end Fix_Parent;
+
+ Fields : Node_Field_Array renames
+ Node_Field_Table (Nkind (Fix_Node)).all;
+
+ -- Start of processing for Fix_Parents
- function Parent (N : Node_Id) return Node_Id is
begin
- if Is_List_Member (N) then
- return Parent (List_Containing (N));
- else
- return Node_Id (Nodes.Table (N).Link);
- end if;
- end Parent;
+ 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;
- -------------
- -- Present --
- -------------
+ -----------------------------------
+ -- Get_Comes_From_Source_Default --
+ -----------------------------------
- function Present (N : Node_Id) return Boolean is
+ function Get_Comes_From_Source_Default return Boolean is
begin
- return N /= Empty;
- end Present;
+ return Comes_From_Source_Default;
+ end Get_Comes_From_Source_Default;
- --------------------------------
- -- Preserve_Comes_From_Source --
- --------------------------------
+ ---------------
+ -- Is_Entity --
+ ---------------
- procedure Preserve_Comes_From_Source (NewN, OldN : Node_Id) is
+ function Is_Entity (N : Node_Id) return Boolean is
begin
- Set_Comes_From_Source (NewN, Comes_From_Source (OldN));
- end Preserve_Comes_From_Source;
+ return Nkind (N) in N_Entity;
+ end Is_Entity;
- ----------------------
- -- Print_Statistics --
- ----------------------
+ ----------------
+ -- Initialize --
+ ----------------
- procedure Print_Statistics is
- N_Count : constant Natural := Natural (Nodes.Last - First_Node_Id + 1);
- E_Count : Natural := 0;
+ procedure Initialize is
+ Dummy : Node_Id;
+ pragma Warnings (Off, Dummy);
begin
- Write_Str ("Number of entities: ");
- Write_Eol;
+ -- Allocate Empty node
- declare
- function CP_Lt (Op1, Op2 : Natural) return Boolean;
- -- Compare routine for Sort
+ Dummy := New_Node (N_Empty, No_Location);
+ Set_Chars (Empty, No_Name);
+ pragma Assert (Dummy = Empty);
- procedure CP_Move (From : Natural; To : Natural);
- -- Move routine for Sort
+ -- Allocate Error node, and set Error_Posted, since we certainly
+ -- only generate an Error node if we do post some kind of error.
- Kind_Count : array (Node_Kind) of Natural := (others => 0);
- -- Array of occurrence count per node kind
+ Dummy := New_Node (N_Error, No_Location);
+ Set_Chars (Error, Error_Name);
+ Set_Error_Posted (Error, True);
+ pragma Assert (Dummy = Error);
+ end Initialize;
- Kind_Max : constant Natural := Node_Kind'Pos (N_Unused_At_End) - 1;
- -- The index of the largest (interesting) node kind
+ --------------------------
+ -- Is_Rewrite_Insertion --
+ --------------------------
- Ranking : array (0 .. Kind_Max) of Node_Kind;
- -- Ranking array for node kinds (index 0 is used for the temporary)
+ function Is_Rewrite_Insertion (Node : Node_Id) return Boolean is
+ begin
+ return Rewrite_Ins (Node);
+ end Is_Rewrite_Insertion;
- package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt);
+ -----------------------------
+ -- Is_Rewrite_Substitution --
+ -----------------------------
- function CP_Lt (Op1, Op2 : Natural) return Boolean is
- begin
- return Kind_Count (Ranking (Op2)) < Kind_Count (Ranking (Op1));
- end CP_Lt;
+ function Is_Rewrite_Substitution (Node : Node_Id) return Boolean is
+ begin
+ return Orig_Nodes.Table (Node) /= Node;
+ end Is_Rewrite_Substitution;
- procedure CP_Move (From : Natural; To : Natural) is
- begin
- Ranking (To) := Ranking (From);
- end CP_Move;
+ ------------------
+ -- Last_Node_Id --
+ ------------------
- begin
- -- Count the number of occurrences of each node kind
+ function Last_Node_Id return Node_Id is
+ begin
+ return Node_Offsets.Last;
+ end Last_Node_Id;
- 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;
+ ----------
+ -- Lock --
+ ----------
- -- Sort the node kinds by number of occurrences
+ procedure Lock is
+ begin
+ Orig_Nodes.Locked := True;
+ end Lock;
- for N in 1 .. Kind_Max loop
- Ranking (N) := Node_Kind'Val (N);
- end loop;
+ ----------------
+ -- Lock_Nodes --
+ ----------------
- Sorting.Sort (Kind_Max);
+ procedure Lock_Nodes is
+ begin
+ pragma Assert (not Locked);
+ Locked := True;
+ end Lock_Nodes;
- -- Print the list in descending order
+ -------------------------
+ -- Mark_New_Ghost_Node --
+ -------------------------
- 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;
+ procedure Mark_New_Ghost_Node (N : Node_Or_Entity_Id) is
+ begin
+ pragma Debug (Validate_Node_Write (N));
- E_Count := E_Count + Count;
- end if;
- end;
- end loop;
- end;
+ -- The Ghost node is created within a Ghost region
- Write_Str ("Total number of entities: ");
- Write_Int (Int (E_Count));
- Write_Eol;
+ if Ghost_Mode = Check then
+ if Nkind (N) in N_Entity then
+ Set_Is_Checked_Ghost_Entity (N);
+ end if;
- Write_Str ("Maximum number of nodes per entity: ");
- Write_Int (Int (Num_Extension_Nodes + 1));
- Write_Eol;
+ elsif Ghost_Mode = Ignore then
+ if Nkind (N) in N_Entity then
+ Set_Is_Ignored_Ghost_Entity (N);
+ end if;
- Write_Str ("Number of allocated nodes: ");
- Write_Int (Int (N_Count));
- Write_Eol;
+ Set_Is_Ignored_Ghost_Node (N);
- 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;
+ -- Record the ignored Ghost node or entity in order to eliminate it
+ -- from the tree later.
- Write_Str ("Size of a node in bytes: ");
- Write_Int (Int (Node_Record'Size) / Storage_Unit);
- Write_Eol;
+ if Ignored_Ghost_Recording_Proc /= null then
+ Ignored_Ghost_Recording_Proc.all (N);
+ end if;
+ end if;
+ end Mark_New_Ghost_Node;
- Write_Str ("Memory consumption in bytes: ");
- Write_Int (Int (Long_Long_Integer (N_Count) *
- (Node_Record'Size / Storage_Unit)));
- Write_Eol;
- end Print_Statistics;
+ ----------------------------
+ -- Mark_Rewrite_Insertion --
+ ----------------------------
- -------------------
- -- Relocate_Node --
- -------------------
+ procedure Mark_Rewrite_Insertion (New_Node : Node_Id) is
+ begin
+ Set_Rewrite_Ins (New_Node);
+ end Mark_Rewrite_Insertion;
- function Relocate_Node (Source : Node_Id) return Node_Id is
- New_Node : Node_Id;
+ --------------
+ -- New_Copy --
+ --------------
+
+ 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 No (Source) then
- return Empty;
+ if Source <= Empty_Or_Error then
+ return Source;
end if;
- New_Node := New_Copy (Source);
- Fix_Parents (Ref_Node => Source, Fix_Node => New_Node);
+ New_Id := Alloc_Node_Id;
+ Node_Offsets.Table (New_Id) := Alloc_Slots (S_Size);
+ Orig_Nodes.Append (New_Id);
+ Copy_Slots (Source, New_Id);
- -- We now set the parent of the new node to be the same as the parent of
- -- the source. Almost always this parent will be replaced by a new value
- -- when the relocated node is reattached to the tree, but by doing it
- -- now, we ensure that this node is not even temporarily disconnected
- -- from the tree. Note that this does not happen free, because in the
- -- list case, the parent does not get set.
+ 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_Parent (New_Node, Parent (Source));
+ Allocate_List_Tables (New_Id);
+ Report (Target => New_Id, Source => Source);
- -- If the node being relocated was a rewriting of some original node,
- -- then the relocated node has the same original node.
+ Set_In_List (New_Id, False);
+ Set_Link (New_Id, Empty_List_Or_Node);
- if Is_Rewrite_Substitution (Source) then
- Orig_Nodes.Table (New_Node) := Orig_Nodes.Table (Source);
- end if;
-
- return New_Node;
- end Relocate_Node;
-
- -------------
- -- Replace --
- -------------
-
- 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;
-
- 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 the original is marked as a rewrite insertion, then unmark the
+ -- copy, since we inserted the original, not the copy.
- -- Do copy, preserving link and in list status and required flags
+ Set_Rewrite_Ins (New_Id, False);
+ pragma Debug (New_Node_Debugging_Output (New_Id));
- 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;
+ -- Clear Is_Overloaded since we cannot have semantic interpretations
+ -- of this new node.
- -- Fix parents of substituted node, since it has changed identity
+ if Nkind (Source) in N_Subexpr then
+ Set_Is_Overloaded (New_Id, False);
+ end if;
- Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
+ -- Always clear Has_Aspects, the caller must take care of copying
+ -- aspects if this is required for the particular situation.
- -- 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.
+ Set_Has_Aspects (New_Id, False);
- Orig_Nodes.Table (Old_Node) := Old_Node;
+ -- Mark the copy as Ghost depending on the current Ghost region
- -- Invoke the reporting procedure (if available)
+ Mark_New_Ghost_Node (New_Id);
- if Reporting_Proc /= null then
- Reporting_Proc.all (Target => Old_Node, Source => New_Node);
- end if;
- end Replace;
+ pragma Assert (New_Id /= Source);
+ return New_Id;
+ end New_Copy;
- ------------
- -- Report --
- ------------
+ ----------------
+ -- New_Entity --
+ ----------------
- procedure Report (Target, Source : Node_Id) is
+ function New_Entity
+ (New_Node_Kind : Node_Kind;
+ 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_Node_Kind);
+ pragma Assert (Original_Node (Node_Offsets.Last) = Node_Offsets.Last);
begin
- if Reporting_Proc /= null then
- Reporting_Proc.all (Target, Source);
- end if;
- end Report;
-
- -------------
- -- Rewrite --
- -------------
-
- procedure Rewrite (Old_Node, New_Node : Node_Id) is
-
- -- Flags table attributes
+ -- 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.
- Old_CA : constant Boolean := Flags.Table (Old_Node).Check_Actuals;
- Old_Is_IGN : constant Boolean :=
- Flags.Table (Old_Node).Is_Ignored_Ghost_Node;
+ if New_Sloc > No_Location and then Comes_From_Source_Default then
+ Current_Error_Node := New_Id;
+ end if;
- -- Nodes table attributes
+ Set_Sloc (New_Id, New_Sloc);
+ pragma Debug (New_Node_Debugging_Output (New_Id));
- Old_Error_Posted : constant Boolean :=
- Nodes.Table (Old_Node).Error_Posted;
- Old_Has_Aspects : constant Boolean :=
- Nodes.Table (Old_Node).Has_Aspects;
+ -- Mark the new entity as Ghost depending on the current Ghost region
- Old_Must_Not_Freeze : Boolean;
- Old_Paren_Count : Nat;
- -- These fields are preserved in the new node only if the new node and
- -- the old node are both subexpression nodes.
+ Mark_New_Ghost_Node (New_Id);
- -- Note: it is a violation of abstraction levels for Must_Not_Freeze
- -- to be referenced like this. ???
+ return New_Id;
+ end New_Entity;
- Sav_Node : Node_Id;
+ --------------
+ -- New_Node --
+ --------------
+ function New_Node
+ (New_Node_Kind : Node_Kind;
+ 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 (New_Node_Kind);
+ pragma Assert (Original_Node (Node_Offsets.Last) = Node_Offsets.Last);
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;
-
- -- Allocate a new node, to be used to preserve the original contents
- -- of the Old_Node, for possible later retrival by Original_Node and
- -- make an entry in the Orig_Nodes table. This is only done if we have
- -- 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
- Sav_Node := New_Copy (Old_Node);
- Orig_Nodes.Table (Sav_Node) := Sav_Node;
- Orig_Nodes.Table (Old_Node) := Sav_Node;
+ Set_Sloc (New_Id, New_Sloc);
+ pragma Debug (New_Node_Debugging_Output (New_Id));
- -- Both the old and new copies of the node will share the same list
- -- of aspect specifications if aspect specifications are present.
+ -- 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 an error location for the bomb.
- if Old_Has_Aspects then
- Set_Aspect_Specifications
- (Sav_Node, Aspect_Specifications (Old_Node));
- end if;
+ if Comes_From_Source_Default and then New_Sloc > No_Location then
+ Current_Error_Node := New_Id;
end if;
- -- Copy substitute node into place, preserving old fields as required
+ -- Mark the new node as Ghost depending on the current Ghost region
- 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;
+ Mark_New_Ghost_Node (New_Id);
- Flags.Table (Old_Node).Check_Actuals := Old_CA;
- Flags.Table (Old_Node).Is_Ignored_Ghost_Node := Old_Is_IGN;
+ return New_Id;
+ end New_Node;
- if Nkind (New_Node) in N_Subexpr then
- Set_Paren_Count (Old_Node, Old_Paren_Count);
- Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze);
- end if;
+ -------------------------
+ -- New_Node_Breakpoint --
+ -------------------------
- Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
+ procedure nn is
+ begin
+ Write_Str ("Watched node ");
+ Write_Int (Int (Watch_Node));
+ Write_Eol;
+ end nn;
- -- Invoke the reporting procedure (if available)
+ -------------------------------
+ -- New_Node_Debugging_Output --
+ -------------------------------
- if Reporting_Proc /= null then
- Reporting_Proc.all (Target => Old_Node, Source => New_Node);
- end if;
+ procedure nnd (N : Node_Id) is
+ Node_Is_Watched : constant Boolean := N = Watch_Node;
- -- Invoke the rewriting procedure (if available)
+ begin
+ if Debug_Flag_N or else Node_Is_Watched then
+ Node_Debug_Output ("Node", N);
- if Rewriting_Proc /= null then
- Rewriting_Proc.all (Target => Old_Node, Source => New_Node);
+ if Node_Is_Watched then
+ New_Node_Breakpoint;
+ end if;
end if;
- end Rewrite;
+ end nnd;
- ------------------
- -- Set_Analyzed --
- ------------------
+ --------
+ -- No --
+ --------
- procedure Set_Analyzed (N : Node_Id; Val : Boolean := True) is
+ function No (N : Node_Id) return Boolean is
begin
- pragma Assert (not Locked);
- Nodes.Table (N).Analyzed := Val;
- end Set_Analyzed;
+ return N = Empty;
+ end No;
-----------------------
- -- Set_Check_Actuals --
+ -- Node_Debug_Output --
-----------------------
- procedure Set_Check_Actuals (N : Node_Id; Val : Boolean := True) is
+ procedure Node_Debug_Output (Op : String; N : Node_Id) is
begin
- pragma Assert (not Locked);
- Flags.Table (N).Check_Actuals := Val;
- end Set_Check_Actuals;
+ Write_Str (Op);
- ---------------------------
- -- Set_Comes_From_Source --
- ---------------------------
+ if Nkind (N) in N_Entity then
+ Write_Str (" entity");
+ else
+ Write_Str (" node");
+ end if;
- 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;
+ Write_Str (" Id = ");
+ Write_Int (Int (N));
+ Write_Str (" ");
+ Write_Location (Sloc (N));
+ Write_Str (" ");
+ Write_Str (Node_Kind'Image (Nkind (N)));
+ Write_Eol;
+ end Node_Debug_Output;
- -----------------------------------
- -- Set_Comes_From_Source_Default --
- -----------------------------------
+ -------------------
+ -- Nodes_Address --
+ -------------------
- procedure Set_Comes_From_Source_Default (Default : Boolean) is
+ function Node_Offsets_Address return System.Address is
begin
- Comes_From_Source_Default := Default;
- end Set_Comes_From_Source_Default;
+ return Node_Offsets.Table (First_Node_Id)'Address;
+ end Node_Offsets_Address;
- ---------------
- -- Set_Ekind --
- ---------------
+ Slot_Byte_Size : constant := 4;
+ pragma Assert (Slot_Byte_Size * 8 = Slot'Size);
- procedure Set_Ekind (E : Entity_Id; Val : Entity_Kind) is
+ 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
- pragma Assert (not Locked);
- pragma Assert (Nkind (E) in N_Entity);
- Nodes.Table (E + 1).Nkind := E_To_N (Val);
- end Set_Ekind;
+ return Slots.Table (Slots_Low_Bound)'Address - Extra;
+ end Slots_Address;
- ----------------------
- -- Set_Error_Posted --
- ----------------------
+ -----------------------------------
+ -- Approx_Num_Nodes_And_Entities --
+ -----------------------------------
- procedure Set_Error_Posted (N : Node_Id; Val : Boolean := True) is
+ function Approx_Num_Nodes_And_Entities return Nat is
begin
- pragma Assert (not Locked);
- Nodes.Table (N).Error_Posted := Val;
- end Set_Error_Posted;
+ return Nat (Node_Offsets.Last - First_Node_Id);
+ end Approx_Num_Nodes_And_Entities;
- ---------------------
- -- Set_Has_Aspects --
- ---------------------
+ -----------
+ -- Off_0 --
+ -----------
+
+ function Off_0 (N : Node_Id) return Node_Offset is
+ pragma Debug (Validate_Node (N));
- procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True) is
+ All_Node_Offsets : Node_Offsets.Table_Type renames
+ Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last);
begin
- pragma Assert (not Locked);
- pragma Assert (N <= Nodes.Last);
- Nodes.Table (N).Has_Aspects := Val;
- end Set_Has_Aspects;
+ return All_Node_Offsets (N);
+ end Off_0;
- --------------------------------------
- -- Set_Ignored_Ghost_Recording_Proc --
- --------------------------------------
+ -----------
+ -- Off_L --
+ -----------
- procedure Set_Ignored_Ghost_Recording_Proc
- (Proc : Ignored_Ghost_Record_Proc)
- is
+ 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
- pragma Assert (Ignored_Ghost_Recording_Proc = null);
- Ignored_Ghost_Recording_Proc := Proc;
- end Set_Ignored_Ghost_Recording_Proc;
+ return All_Node_Offsets (N) + Size_In_Slots (N) - 1;
+ end Off_L;
- -------------------------------
- -- Set_Is_Ignored_Ghost_Node --
- -------------------------------
+ -------------------
+ -- Original_Node --
+ -------------------
- procedure Set_Is_Ignored_Ghost_Node (N : Node_Id; Val : Boolean := True) is
+ function Original_Node (Node : Node_Id) return Node_Id is
begin
- pragma Assert (not Locked);
- Flags.Table (N).Is_Ignored_Ghost_Node := Val;
- end Set_Is_Ignored_Ghost_Node;
+ pragma Debug (Validate_Node (Node));
- -----------------------
- -- Set_Original_Node --
- -----------------------
+ return Orig_Nodes.Table (Node);
+ end Original_Node;
- procedure Set_Original_Node (N : Node_Id; Val : Node_Id) is
- begin
- pragma Assert (not Locked);
- Orig_Nodes.Table (N) := Val;
- end Set_Original_Node;
+ -----------------
+ -- Paren_Count --
+ -----------------
- ---------------------
- -- Set_Paren_Count --
- ---------------------
+ function Paren_Count (N : Node_Id) return Nat is
+ pragma Debug (Validate_Node (N));
+
+ C : constant Small_Paren_Count_Type := Small_Paren_Count (N);
- procedure Set_Paren_Count (N : Node_Id; Val : Nat) is
begin
- pragma Assert (not Locked);
- pragma Assert (Nkind (N) in N_Subexpr);
+ -- Value of 0,1,2 returned as is
- -- 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);
+ if C <= 2 then
+ return C;
- -- Value of 3 or greater stores 3 in node and makes table entry
+ -- Value of 3 means we search the table, and we must find an entry
else
- Nodes.Table (N).Pflag1 := True;
- Nodes.Table (N).Pflag2 := True;
-
- -- Search for existing table entry
-
for J in Paren_Counts.First .. Paren_Counts.Last loop
if N = Paren_Counts.Table (J).Nod then
- Paren_Counts.Table (J).Count := Val;
- return;
+ return Paren_Counts.Table (J).Count;
end if;
end loop;
- -- No existing table entry; make a new one
-
- Paren_Counts.Append ((Nod => N, Count => Val));
+ raise Program_Error;
end if;
- end Set_Paren_Count;
+ end Paren_Count;
- -----------------------------
- -- Set_Paren_Count_Of_Copy --
- -----------------------------
+ ------------
+ -- Parent --
+ ------------
- procedure Set_Paren_Count_Of_Copy (Target, Source : Node_Id) is
+ function Parent (N : Node_Id) return Node_Id is
begin
- -- We already copied the two Pflags. 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
- then
- Set_Paren_Count (Target, Paren_Count (Source));
+ if Is_List_Member (N) then
+ return Parent (List_Containing (N));
+ else
+ return Node_Id (Link (N));
end if;
+ end Parent;
- pragma Assert (Paren_Count (Target) = Paren_Count (Source));
- end Set_Paren_Count_Of_Copy;
-
- ----------------
- -- Set_Parent --
- ----------------
-
- 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);
- end Set_Parent;
-
- ------------------------
- -- Set_Reporting_Proc --
- ------------------------
+ -------------
+ -- Present --
+ -------------
- procedure Set_Reporting_Proc (Proc : Report_Proc) is
+ function Present (N : Node_Id) return Boolean is
begin
- pragma Assert (Reporting_Proc = null);
- Reporting_Proc := Proc;
- end Set_Reporting_Proc;
+ return N /= Empty;
+ end Present;
- --------------
- -- Set_Sloc --
- --------------
+ --------------------------------
+ -- Preserve_Comes_From_Source --
+ --------------------------------
- procedure Set_Sloc (N : Node_Id; Val : Source_Ptr) is
+ procedure Preserve_Comes_From_Source (NewN, OldN : Node_Id) is
begin
- pragma Assert (not Locked);
- Nodes.Table (N).Sloc := Val;
- end Set_Sloc;
+ Set_Comes_From_Source (NewN, Comes_From_Source (OldN));
+ end Preserve_Comes_From_Source;
- ------------------------
- -- Set_Rewriting_Proc --
- ------------------------
+ ----------------------
+ -- Print_Atree_Info --
+ ----------------------
- procedure Set_Rewriting_Proc (Proc : Rewrite_Proc) is
+ procedure Print_Atree_Info (N : Node_Or_Entity_Id) is
+ function Cast is new Unchecked_Conversion (Slot_32_Bit, Int);
begin
- pragma Assert (Rewriting_Proc = null);
- Rewriting_Proc := Proc;
- end Set_Rewriting_Proc;
+ 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 ("):");
- ----------
- -- Sloc --
- ----------
+ for Off in Off_0 (N) .. Off_L (N) loop
+ Write_Str (" ");
+ Write_Int (Cast (Slots.Table (Off).Slot_32));
+ end loop;
- function Sloc (N : Node_Id) return Source_Ptr is
- begin
- return Nodes.Table (N).Sloc;
- end Sloc;
+ Write_Eol;
+ end Print_Atree_Info;
-------------------
- -- Traverse_Func --
+ -- Relocate_Node --
-------------------
- function Traverse_Func (Node : Node_Id) return Traverse_Final_Result is
-
- 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).
-
- --------------------
- -- Traverse_Field --
- --------------------
-
- function Traverse_Field
- (Nod : Node_Id;
- Fld : Union_Id;
- FN : Field_Num) return Traverse_Final_Result
- is
- begin
- if Fld = Union_Id (Empty) then
- return OK;
-
- -- Descendant is a node
-
- elsif Fld in Node_Range then
-
- -- Traverse descendant that is syntactic subtree node
-
- if Is_Syntactic_Field (Nkind (Nod), FN) then
- return Traverse_Func (Node_Id (Fld));
-
- -- Node that is not a syntactic subtree
-
- else
- return OK;
- end if;
+ function Relocate_Node (Source : Node_Id) return Node_Id is
+ New_Node : Node_Id;
- -- Descendant is a list
+ begin
+ if No (Source) then
+ return Empty;
+ end if;
- elsif Fld in List_Range then
+ New_Node := New_Copy (Source);
+ Fix_Parents (Ref_Node => Source, Fix_Node => New_Node);
- -- Traverse descendant that is a syntactic subtree list
+ -- We now set the parent of the new node to be the same as the parent of
+ -- the source. Almost always this parent will be replaced by a new value
+ -- when the relocated node is reattached to the tree, but by doing it
+ -- now, we ensure that this node is not even temporarily disconnected
+ -- from the tree. Note that this does not happen free, because in the
+ -- list case, the parent does not get set.
- if Is_Syntactic_Field (Nkind (Nod), FN) then
- declare
- Elmt : Node_Id := First (List_Id (Fld));
+ Set_Parent (New_Node, Parent (Source));
- begin
- while Present (Elmt) loop
- if Traverse_Func (Elmt) = Abandon then
- return Abandon;
- else
- Next (Elmt);
- end if;
- end loop;
+ -- If the node being relocated was a rewriting of some original node,
+ -- then the relocated node has the same original node.
- return OK;
- end;
+ if Is_Rewrite_Substitution (Source) then
+ Set_Original_Node (New_Node, Original_Node (Source));
+ end if;
- -- List that is not a syntactic subtree
+ return New_Node;
+ end Relocate_Node;
- else
- return OK;
- end if;
+ -------------
+ -- Replace --
+ -------------
- -- Field was not a node or a list
+ procedure Replace (Old_Node, New_Node : Node_Id) is
+ pragma Debug (New_Node_Debugging_Output (Old_Node));
+ pragma Debug (New_Node_Debugging_Output (New_Node));
- else
- return OK;
- end if;
- end Traverse_Field;
+ 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);
- Cur_Node : Node_Id := Node;
+ procedure Destroy_New_Node;
+ -- Overwrite New_Node data with junk, for debugging purposes
- -- Start of processing for Traverse_Func
+ procedure Destroy_New_Node is
+ begin
+ Zero_Slots (New_Node);
+ Node_Offsets.Table (New_Node) := Field_Offset'Base'Last;
+ end Destroy_New_Node;
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.
+ pragma Assert
+ (not Is_Entity (Old_Node)
+ and not Is_Entity (New_Node)
+ and not In_List (New_Node)
+ and Old_Node /= New_Node);
- <<Tail_Recurse>>
+ -- Do copy, preserving link and in list status and required flags
- case Process (Cur_Node) is
- when Abandon =>
- return Abandon;
+ Copy_Node (Source => New_Node, Destination => Old_Node);
+ Set_Comes_From_Source (Old_Node, Old_CFS);
+ Set_Error_Posted (Old_Node, Old_Post);
+ Set_Has_Aspects (Old_Node, Old_HasA);
- when Skip =>
- return OK;
+ -- Fix parents of substituted node, since it has changed identity
- when OK =>
- null;
+ Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
- when OK_Orig =>
- Cur_Node := Original_Node (Cur_Node);
- end case;
+ pragma Debug (Destroy_New_Node);
- 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;
+ -- 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.
- if Field2 (Cur_Node) not in Node_Range then
- return Traverse_Field (Cur_Node, Field2 (Cur_Node), 2);
+ Set_Original_Node (Old_Node, Old_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.
+ -- Invoke the reporting procedure (if available)
- Cur_Node := Node_Id (Field2 (Cur_Node));
- goto Tail_Recurse;
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => Old_Node, Source => New_Node);
end if;
+ end Replace;
- return OK;
- end Traverse_Func;
-
- -------------------
- -- Traverse_Proc --
- -------------------
+ ------------
+ -- Report --
+ ------------
- procedure Traverse_Proc (Node : Node_Id) is
- function Traverse is new Traverse_Func (Process);
- Discard : Traverse_Final_Result;
- pragma Warnings (Off, Discard);
+ procedure Report (Target, Source : Node_Id) is
begin
- Discard := Traverse (Node);
- end Traverse_Proc;
-
- ------------------------------
- -- Unchecked Access Package --
- ------------------------------
-
- package body Unchecked_Access is
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target, Source);
+ end if;
+ end Report;
- function Field1 (N : Node_Id) return Union_Id is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Field1;
- end Field1;
+ -------------
+ -- Rewrite --
+ -------------
- function Field2 (N : Node_Id) return Union_Id is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Field2;
- end Field2;
+ 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));
- function Field3 (N : Node_Id) return Union_Id is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Field3;
- end Field3;
+ Old_CA : constant Boolean := Check_Actuals (Old_Node);
+ Old_Is_IGN : constant Boolean := Is_Ignored_Ghost_Node (Old_Node);
+ Old_Error_Posted : constant Boolean :=
+ Error_Posted (Old_Node);
+ Old_Has_Aspects : constant Boolean :=
+ Has_Aspects (Old_Node);
- function Field4 (N : Node_Id) return Union_Id is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Field4;
- end Field4;
+ 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. 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.
- function Field5 (N : Node_Id) return Union_Id is
- begin
- pragma Assert (N <= Nodes.Last);
- return Nodes.Table (N).Field5;
- end Field5;
+ -- Note: it is a violation of abstraction levels for Must_Not_Freeze
+ -- to be referenced like this. ???
- 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;
+ Sav_Node : Node_Id;
- 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;
+ begin
+ pragma Assert
+ (not Is_Entity (Old_Node)
+ and not Is_Entity (New_Node)
+ and not In_List (New_Node));
- 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;
+ -- Allocate a new node, to be used to preserve the original contents
+ -- of the Old_Node, for possible later retrival by Original_Node and
+ -- make an entry in the Orig_Nodes table. This is only done if we have
+ -- not already rewritten the node, as indicated by an Orig_Nodes entry
+ -- that does not reference the Old_Node.
- 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;
+ if Original_Node (Old_Node) = Old_Node then
+ Sav_Node := New_Copy (Old_Node);
+ Set_Original_Node (Sav_Node, Sav_Node);
+ Set_Original_Node (Old_Node, Sav_Node);
- 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;
+ -- Both the old and new copies of the node will share the same list
+ -- of aspect specifications if aspect specifications are present.
- 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;
+ if Old_Has_Aspects then
+ Set_Aspect_Specifications
+ (Sav_Node, Aspect_Specifications (Old_Node));
+ end if;
+ end if;
- 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;
+ -- Copy substitute node into place, preserving old fields as required
- 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;
+ Copy_Node (Source => New_Node, Destination => Old_Node);
+ Set_Error_Posted (Old_Node, Old_Error_Posted);
+ Set_Has_Aspects (Old_Node, Old_Has_Aspects);
- 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;
+ Set_Check_Actuals (Old_Node, Old_CA);
+ Set_Is_Ignored_Ghost_Node (Old_Node, Old_Is_IGN);
- 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;
+ if Nkind (New_Node) in N_Subexpr then
+ Set_Paren_Count (Old_Node, Old_Paren_Count);
+ Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze);
+ end if;
- 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;
+ Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
- 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;
+ -- Invoke the reporting procedure (if available)
- 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;
+ if Reporting_Proc /= null then
+ Reporting_Proc.all (Target => Old_Node, Source => New_Node);
+ end if;
- 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;
+ -- Invoke the rewriting procedure (if available)
- 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;
+ if Rewriting_Proc /= null then
+ Rewriting_Proc.all (Target => Old_Node, Source => New_Node);
+ end if;
+ end Rewrite;
- 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;
+ -----------------------------------
+ -- Set_Comes_From_Source_Default --
+ -----------------------------------
- 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_Comes_From_Source_Default (Default : Boolean) is
+ begin
+ Comes_From_Source_Default := Default;
+ end Set_Comes_From_Source_Default;
- 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;
+ --------------------------------------
+ -- Set_Ignored_Ghost_Recording_Proc --
+ --------------------------------------
- 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_Ignored_Ghost_Recording_Proc
+ (Proc : Ignored_Ghost_Record_Proc)
+ is
+ begin
+ pragma Assert (Ignored_Ghost_Recording_Proc = null);
+ Ignored_Ghost_Recording_Proc := Proc;
+ end Set_Ignored_Ghost_Recording_Proc;
- 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;
+ -----------------------
+ -- Set_Original_Node --
+ -----------------------
- 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_Original_Node (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Debug (Validate_Node_Write (N));
- 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;
+ Orig_Nodes.Table (N) := Val;
+ end Set_Original_Node;
- 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;
+ ---------------------
+ -- Set_Paren_Count --
+ ---------------------
- 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_Paren_Count (N : Node_Id; Val : Nat) is
+ begin
+ pragma Debug (Validate_Node_Write (N));
+ pragma Assert (Nkind (N) in N_Subexpr);
- 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;
+ -- Value of 0,1,2 stored as is
- 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;
+ if Val <= 2 then
+ Set_Small_Paren_Count (N, Val);
- 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;
+ -- Value of 3 or greater stores 3 in node and makes table entry
- 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;
+ else
+ Set_Small_Paren_Count (N, 3);
- 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;
+ -- Search for existing table entry
- 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;
+ for J in Paren_Counts.First .. Paren_Counts.Last loop
+ if N = Paren_Counts.Table (J).Nod then
+ Paren_Counts.Table (J).Count := Val;
+ return;
+ end if;
+ end loop;
- 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;
+ -- No existing table entry; make a new one
- 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;
+ Paren_Counts.Append ((Nod => N, Count => Val));
+ end if;
+ end Set_Paren_Count;
- 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;
+ -----------------------------
+ -- Set_Paren_Count_Of_Copy --
+ -----------------------------
- 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_Paren_Count_Of_Copy (Target, Source : Node_Id) is
+ begin
+ -- We already copied the Small_Paren_Count. We need to update the
+ -- Paren_Counts table only if greater than 2.
- 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;
+ if Nkind (Source) in N_Subexpr
+ and then Small_Paren_Count (Source) = 3
+ then
+ Set_Paren_Count (Target, Paren_Count (Source));
+ end if;
- 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;
+ pragma Assert (Paren_Count (Target) = Paren_Count (Source));
+ end Set_Paren_Count_Of_Copy;
- 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;
+ ----------------
+ -- Set_Parent --
+ ----------------
- 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_Parent (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (not Locked);
+ pragma Assert (not In_List (N));
+ Set_Link (N, Union_Id (Val));
+ end Set_Parent;
- 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;
+ ------------------------
+ -- Set_Reporting_Proc --
+ ------------------------
- 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_Reporting_Proc (Proc : Report_Proc) is
+ begin
+ pragma Assert (Reporting_Proc = null);
+ Reporting_Proc := Proc;
+ end Set_Reporting_Proc;
- 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;
+ ------------------------
+ -- Set_Rewriting_Proc --
+ ------------------------
- 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_Rewriting_Proc (Proc : Rewrite_Proc) is
+ begin
+ pragma Assert (Rewriting_Proc = null);
+ Rewriting_Proc := Proc;
+ end Set_Rewriting_Proc;
- 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;
+ 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;
- 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;
+ function Size_In_Slots_To_Alloc
+ (N : Node_Or_Entity_Id) return Field_Offset is
+ begin
+ return Size_In_Slots_To_Alloc (Nkind (N));
+ end Size_In_Slots_To_Alloc;
- 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;
+ 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;
- 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;
+ -------------------
+ -- Traverse_Func --
+ -------------------
- 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;
+ function Traverse_Func (Node : Node_Id) return Traverse_Final_Result is
+ pragma Debug (Validate_Node (Node));
- 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;
+ 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.
- 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;
+ --------------------
+ -- Traverse_Field --
+ --------------------
- procedure Set_Flag305 (N : Node_Id; Val : Boolean) is
+ function Traverse_Field (Fld : Union_Id) return Traverse_Final_Result is
begin
- pragma Assert (not Locked);
- pragma Assert (Nkind (N) in N_Entity);
- Nodes.Table (N + 5).Flag16 := Val;
- end Set_Flag305;
+ if Fld /= Union_Id (Empty) then
- 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;
+ -- Descendant is a node
- 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;
+ if Fld in Node_Range then
+ return Traverse_Func (Node_Id (Fld));
- 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;
+ -- Descendant is a list
- 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;
+ 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;
+ end if;
- 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);
+ Next (Elmt);
+ end loop;
+ end;
- if Val > Error then
- Set_Parent (N => Val, Val => N);
+ else
+ raise Program_Error;
+ end if;
end if;
- Set_Node1 (N, Val);
- end Set_Node1_With_Parent;
+ return OK;
+ end Traverse_Field;
- procedure Set_Node2_With_Parent (N : Node_Id; Val : Node_Id) is
- begin
- pragma Assert (not Locked);
- pragma Assert (N <= Nodes.Last);
+ Cur_Node : Node_Id := Node;
- if Val > Error then
- Set_Parent (N => Val, Val => N);
- end if;
+ -- Start of processing for Traverse_Func
- Set_Node2 (N, Val);
- end Set_Node2_With_Parent;
+ begin
+ -- 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.)
- procedure Set_Node3_With_Parent (N : Node_Id; Val : Node_Id) is
- begin
- pragma Assert (not Locked);
- pragma Assert (N <= Nodes.Last);
+ <<Tail_Recurse>>
- if Val > Error then
- Set_Parent (N => Val, Val => N);
- end if;
+ case Process (Cur_Node) is
+ when Abandon =>
+ return Abandon;
- Set_Node3 (N, Val);
- end Set_Node3_With_Parent;
+ when Skip =>
+ return OK;
- procedure Set_Node4_With_Parent (N : Node_Id; Val : Node_Id) is
- begin
- pragma Assert (not Locked);
- pragma Assert (N <= Nodes.Last);
+ when OK =>
+ null;
- if Val > Error then
- Set_Parent (N => Val, Val => N);
- end if;
+ when OK_Orig =>
+ Cur_Node := Original_Node (Cur_Node);
+ end case;
- Set_Node4 (N, Val);
- end Set_Node4_With_Parent;
+ -- Check for empty Traversed_Fields before entering loop below, so the
+ -- tail recursive step won't go past the end.
- procedure Set_Node5_With_Parent (N : Node_Id; Val : Node_Id) is
- begin
- pragma Assert (not Locked);
- pragma Assert (N <= Nodes.Last);
+ declare
+ Cur_Field : Offset_Array_Index := Traversed_Offset_Array'First;
+ Offsets : Traversed_Offset_Array renames
+ Traversed_Fields (Nkind (Cur_Node));
- if Val > Error then
- Set_Parent (N => Val, Val => N);
- end if;
+ 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));
- Set_Node5 (N, Val);
- end Set_Node5_With_Parent;
+ begin
+ if Traverse_Field (F) = Abandon then
+ return Abandon;
+ end if;
+ end;
- 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;
+ Cur_Field := Cur_Field + 1;
+ end loop;
- 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;
+ declare
+ F : constant Union_Id :=
+ Get_Node_Field_Union (Cur_Node, Offsets (Cur_Field));
- 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);
+ 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;
- Set_List3 (N, Val);
- end Set_List3_With_Parent;
+ end;
- 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;
+ return OK;
+ end Traverse_Func;
- 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;
+ -------------------
+ -- Traverse_Proc --
+ -------------------
- end Unchecked_Access;
+ procedure Traverse_Proc (Node : Node_Id) is
+ function Traverse is new Traverse_Func (Process);
+ Discard : Traverse_Final_Result;
+ pragma Warnings (Off, Discard);
+ begin
+ Discard := Traverse (Node);
+ end Traverse_Proc;
------------
-- Unlock --
procedure Unlock is
begin
- Flags.Locked := False;
Orig_Nodes.Locked := False;
end Unlock;
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;
------------------------------------------------------------------------------
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
-- 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.
-- 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
-- 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,
-- 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 --
-- 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,
-- 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 --
-- 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
-- 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.
-- 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);
-- 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
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
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 --
---------------------------
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).
-- 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);
+ 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.
- function Flag47 (N : Node_Id) return Boolean;
- pragma Inline (Flag47);
+ -----------------------------
+ -- Private Part Subpackage --
+ -----------------------------
- function Flag48 (N : Node_Id) return Boolean;
- pragma Inline (Flag48);
+ -- The following package contains the definition of the data structure
+ -- used by the implementation of the Atree package. Logically it really
+ -- corresponds to the private part, hence the name. The reason that it
+ -- is defined as a sub-package is to allow special access from clients
+ -- that need to see the internals of the data structures.
- function Flag49 (N : Node_Id) return Boolean;
- pragma Inline (Flag49);
+ package Atree_Private_Part is
- function Flag50 (N : Node_Id) return Boolean;
- pragma Inline (Flag50);
+ 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
- function Flag51 (N : Node_Id) return Boolean;
- pragma Inline (Flag51);
+ -------------------------
+ -- Tree Representation --
+ -------------------------
- 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;
-
- -----------------------------
- -- Private Part Subpackage --
- -----------------------------
-
- -- The following package contains the definition of the data structure
- -- used by the implementation of the Atree package. Logically it really
- -- corresponds to the private part, hence the name. The reason that it
- -- is defined as a sub-package is to allow special access from clients
- -- that need to see the internals of the data structures.
-
- package Atree_Private_Part is
-
- -------------------------
- -- 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;
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;
INLINE Boolean
Present (Tree_Id N)
{
- return N != Empty;
+ return !No (N);
}
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
}
(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;
(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,
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
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;
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;
Append_To (New_Alts,
Make_Case_Expression_Alternative (Sloc (Alt),
- Actions => No_List,
Discrete_Choices => Discrete_Choices (Alt),
Expression => New_Exp));
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;
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;
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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
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;
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;
-- 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);
-- 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
-- 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
-- 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
-- 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
-- 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.
-- 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.
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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- --
------------------------------------------------------------------------------
-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;
-- --
------------------------------------------------------------------------------
+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.
-- 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.
-- 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.
-- 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
-- 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.
--------------------------------
-- 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 --
-- 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)
-- 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)
-- 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)
-- (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)
-- 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)
-- (plus type attributes)
-- E_Block
+ -- Renamed_Entity $$$???
+ -- Renamed_Object $$$???
-- Return_Applies_To (Node8)
-- Block_Node (Node11)
-- First_Entity (Node17)
-- 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)
-- 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)
-- 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)
-- 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)
-- 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)
-- 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)
-- Activation_Record_Component (Node31)
-- Discard_Names (Flag88)
-- Is_Raised (Flag224)
+ -- Renamed_Object $$$???
-- E_Exception_Type
-- Equivalent_Type (Node18)
-- 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)
-- 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)
-- 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)
-- 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)
-- 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
-- (plus type attributes)
-- E_Named_Integer
+ -- Renamed_Object $$$???
-- E_Named_Real
-- 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 ???
-- 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)
-- 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)
-- 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)
-- 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)
-- 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)
-- 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)
-- 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)
-- 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
-- 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)
-- 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)
-- 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)
-- 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)
-- 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)
-- 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)
-- SPARK_Pragma (Node40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- SPARK_Pragma_Inherited (Flag265)
+ -- Interface_Name $$$???
+ -- Renamed_Entity $$$???
-- Scope_Depth (synth)
-- E_Subprogram_Type
-- Last_Formal (synth)
-- Number_Formals (synth)
-- Returns_By_Ref (Flag90)
+ -- First_Entity $$$???
+ -- Last_Entity $$$???
+ -- Interface_Name $$$???
-- (plus type attributes)
-- E_Task_Body
-- SPARK_Pragma (Node40)
-- Ignore_SPARK_Mode_Pragmas (Flag301)
-- SPARK_Pragma_Inherited (Flag265)
+ -- First_Entity $$$???
-- (any others??? First/Last Entity, Scope_Depth???)
-- E_Task_Type
-- Unset_Reference (Node16)
-- Actual_Subtype (Node17)
-- Renamed_Object (Node18)
+ -- Renamed_Entity $$$???
+ -- Discriminal_Link $$$???
-- Size_Check_Code (Node19)
-- Prival_Link (Node20)
-- Interface_Name (Node21)
-- 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 --
-- 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 --
----------------------------------
-- 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;
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;
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;
-- 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
-- --
------------------------------------------------------------------------------
-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;
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;
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;
------------------------------------------------------------------------------
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;
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;
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;
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;
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
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
------------------------------------------------------------------------------
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;
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;
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);
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
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)));
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
-- 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
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;
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;
------------------------------------------------------------------------------
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;
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;
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;
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;
------------------------------------------------------------------------------
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;
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;
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;
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;
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;
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;
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,
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
------------------------------------------------------------------------------
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
------------------------------------------------------------------------------
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;
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;
-- --
------------------------------------------------------------------------------
-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;
------------------------------------------------------------------------------
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;
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;
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;
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;
------------------------------------------------------------------------------
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;
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;
------------------------------------------------------------------------------
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;
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
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;
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;
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;
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;
-- 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
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
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;
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
/* 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);
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);
/* 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);
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
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;
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;
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);
-- 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)
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;
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 \
ada/scng.o \
ada/scos.o \
ada/sdefault.o \
+ ada/seinfo.o \
ada/sem.o \
ada/sem_aggr.o \
ada/sem_attr.o \
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 \
ada/targparm.o \
ada/tbuild.o \
ada/treepr.o \
- ada/treeprs.o \
ada/ttypes.o \
ada/types.o \
ada/uintp.o \
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 \
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 \
-$(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)
-$(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:
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 \
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),\
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
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
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))) \
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
|| 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.
/* 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))
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.
/* 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);
}
/* 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
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
}
#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;
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,
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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- 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
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;
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;
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;
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
-- 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;
<<End_Of_Program>>
- if Debug_Flag_Dot_AA then
- Atree.Print_Statistics;
- end if;
-
-- The outer exception handler handles an unrecoverable error
exception
-- 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;
-- --
------------------------------------------------------------------------------
-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;
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;
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;
-- --
------------------------------------------------------------------------------
-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;
-- 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;
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;
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;
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;
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;
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;
-- --
------------------------------------------------------------------------------
-with Einfo; use Einfo;
+with Einfo.Entities; use Einfo.Entities;
with Nmake; use Nmake;
with SPARK_Xrefs; use SPARK_Xrefs;
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;
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;
-- 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
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;
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;
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;
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;
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;
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;
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;
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;
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;
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
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
Line_Start := Index + 1;
end if;
- Index := @ + 1;
+ Index := Index + 1;
end loop;
if Index > Line_Start then
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
------------------------------------------------------------------------------
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
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
-- 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 --
----------------------------------
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");
-----------------------
Set_Last (To, Node);
- Nodes.Table (Node).In_List := True;
+ Set_In_List (Node, True);
Set_Next (Node, Empty);
Set_Prev (Node, L);
Set_Next (After, Node);
- Nodes.Table (Node).In_List := True;
+ Set_In_List (Node, True);
Set_Prev (Node, After);
Set_Next (Node, Before);
Set_Prev (Before, Node);
- Nodes.Table (Node).In_List := True;
+ Set_In_List (Node, True);
Set_Prev (Node, After);
Set_Next (Node, Before);
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;
-----------------------
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;
-----------------
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);
Set_First (To, Node);
- Nodes.Table (Node).In_List := True;
+ Set_In_List (Node, True);
Set_Next (Node, F);
Set_Prev (Node, Empty);
Set_Prev (Nxt, Prv);
end if;
- Nodes.Table (Node).In_List := False;
+ Set_In_List (Node, False);
Set_Parent (Node, Empty);
end Remove;
Set_Prev (Nxt, Empty);
end if;
- Nodes.Table (Frst).In_List := False;
+ Set_In_List (Frst, False);
Set_Parent (Frst, Empty);
return Frst;
end;
Set_Prev (Nxt2, Node);
end if;
- Nodes.Table (Nxt).In_List := False;
+ Set_In_List (Nxt, False);
Set_Parent (Nxt, Empty);
end;
end if;
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;
--------------
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)
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
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
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.
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;
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;
------------------------------------------------------------------------------
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;
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;
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;
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;
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;
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;
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
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;
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;
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;
-- 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;
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;
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;
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;
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;
("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
------------------------------------------------------------------------------
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;
------------------------------------------------------------------------------
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;
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;
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;
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;
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;
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;
-- 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)));
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;
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;
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;
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;
----------------------
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;
-----------------------------
-- 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
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
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
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);
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);
------------------------------------
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;
-----------------------------------
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.
-- 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;
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;
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;
------------------------------------------------------------------------------
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;
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;
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;
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
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
-- 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);
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);
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)));
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
-- 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);
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);
& "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
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;
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;
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;
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;
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;
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;
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);
-- 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
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;
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;
-- 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));
-- 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);
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
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;
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;
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;
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.
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;
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;
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
-- 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
-- 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);
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,
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
------------------------------------------------------------------------------
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;
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;
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;
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;
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;
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;
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;
-- 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;
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;
------------------------------------------------------------------------------
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
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;
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;
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;
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;
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;
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;
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
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
-- --
------------------------------------------------------------------------------
-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;
------------------------------------------------------------------------------
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
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;
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;
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;
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;
Remove (Op_List, Node (Second));
else
- pragma Assert (False);
raise Program_Error;
end if;
end if;
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;
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;
-------------------------------
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.
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
else
return False;
end if;
- end Is_Volatile_Full_Access_Object;
+ end Is_Volatile_Full_Access_Object_Ref;
--------------------------
-- Is_Volatile_Function --
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.
then
return True;
- elsif Is_Volatile_Object (P) then
+ elsif Is_Volatile_Object_Ref (P) then
return True;
else
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
else
return False;
end if;
- end Is_Volatile_Object;
+ end Is_Volatile_Object_Ref;
-----------------------------
-- Iterate_Call_Parameters --
-- 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
-- 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
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
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.
-- 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;
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
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
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 --
------------------------
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;
-- 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.
-- 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
-- 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
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;
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;
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
-- 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;
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;
------------------------------------
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;
---------------------------------------------
--------------------------------------------------------
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;
----------------------------------------------
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;
------------------------------------------------
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;
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);
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- --
------------------------------------------------------------------------------
-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;
-- 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 --
---------------------------------
-- 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,
-- 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
-- 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
-- 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
-- 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
-- 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 --
-- N_Case_Expression_Alternative
-- Sloc points to WHEN
- -- Actions (List1)
+ -- Actions (List1-Sem)
-- Discrete_Choices (List4)
-- Expression (Node3)
-- Has_SP_Choice (Flag15-Sem)
-- 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
-- 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
-- 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)
-- 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
-- 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
-- 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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
with Namet; use Namet;
with Sinfo; use Sinfo;
+with Sinfo.Nodes; use Sinfo.Nodes;
with Types; use Types;
with Uintp; use Uintp;
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 --
----------------------------------
-- 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
-- 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
-- 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
-- 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 --
-------
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 = ");
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
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 --
----------------
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;
-- 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);
Print_Eol;
end if;
+ if Include_Low_Level then
+ Print_Atree_Info (N);
+ end if;
+
if N = Empty then
return;
end if;
-- 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
-- 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=");
-- 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;
-- Print Right_Opnd
- Print_Str (Prefix_Str_Char);
+ Print_Str (Prefix);
Print_Str ("Right_Opnd = ");
Print_Node_Ref (Right_Opnd (N));
Print_Eol;
-- 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;
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;
-- 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;
-- 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;
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;
-- 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;
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;
-- 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
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;
-- 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.
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,
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);
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
-- 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
-- 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;
-- 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;
-- 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;
-- 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;
-- 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 --
------------------------------
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;
#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
#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
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
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
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))) \
projects / thirdparty / gcc.git / commitdiff
