From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 594EC398B415; Tue, 15 Jun 2021 10:21:01 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 594EC398B415 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-1454] [Ada] Variable-sized node types -- cleanup X-Act-Checkin: gcc X-Git-Author: Bob Duff X-Git-Refname: refs/heads/master X-Git-Oldrev: 81e68a1954366f6b1730d75c932814121d743aa3 X-Git-Newrev: a7cadd18606c9c3ce2776b6f876ca98849b24b84 Message-Id: <20210615102101.594EC398B415@sourceware.org> Date: Tue, 15 Jun 2021 10:21:01 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 15 Jun 2021 10:21:01 -0000 https://gcc.gnu.org/g:a7cadd18606c9c3ce2776b6f876ca98849b24b84 commit r12-1454-ga7cadd18606c9c3ce2776b6f876ca98849b24b84 Author: Bob Duff Date: Thu Feb 25 10:38:55 2021 -0500 [Ada] Variable-sized node types -- cleanup gcc/ada/ * atree.ads, einfo-utils.ads, einfo-utils.adb, fe.h, gen_il.adb, gen_il.ads, gen_il-gen-gen_entities.adb, gen_il-gen-gen_nodes.adb, sem_ch12.adb, sem_ch3.adb, sem_util.adb, sinfo-utils.ads, treepr.adb, types.ads: Clean up ??? comments and other comments. * atree.adb: Clean up ??? comments and other comments. (Validate_Node): Fix bug: "Off_0 (N) < Off_L (N)" should be "Off_0 (N) <= Off_L (N)". * gen_il-gen.adb, gen_il-gen.ads: Clean up ??? comments and other comments. Add support for getter-specific and setter-specific preconditions. Detect the error of putting a field in the wrong subrange. Misc cleanup. (Node_Field vs. Entity_Field): Clean up Nmake. Improve comments. * gen_il-utils.ads: Misc cleanup. Move... * gen_il-internals.ads: ... here. * gen_il-utils.adb: Misc cleanup. Move... * gen_il-internals.adb: ... here. * gen_il-fields.ads: Move Was_Default_Init_Box_Association, which was in the wrong subrange. Add comments. Misc cleanup. * gen_il-types.ads: Add Named_Access_Kind. * sinfo-cn.adb: Clean up ??? comments and other comments. Remove redundant assertions. * einfo.ads, sinfo.ads: Clean up ??? comments and other comments. Remove all the comments indicating field offsets. These are obsolete now that Gen_IL computes the offsets automatically. Diff: --- gcc/ada/atree.adb | 323 +- gcc/ada/atree.ads | 82 +- gcc/ada/einfo-utils.adb | 34 +- gcc/ada/einfo-utils.ads | 37 +- gcc/ada/einfo.ads | 3351 ++++++++++---------- gcc/ada/fe.h | 4 - gcc/ada/gen_il-fields.ads | 35 +- gcc/ada/gen_il-gen-gen_entities.adb | 253 +- gcc/ada/gen_il-gen-gen_nodes.adb | 53 +- gcc/ada/gen_il-gen.adb | 733 +++-- gcc/ada/gen_il-gen.ads | 164 +- gcc/ada/{gen_il-utils.adb => gen_il-internals.adb} | 104 +- gcc/ada/gen_il-internals.ads | 255 ++ gcc/ada/gen_il-types.ads | 94 +- gcc/ada/gen_il-utils.ads | 558 ---- gcc/ada/gen_il.adb | 12 + gcc/ada/gen_il.ads | 280 +- gcc/ada/sem_ch12.adb | 3 +- gcc/ada/sem_ch3.adb | 2 +- gcc/ada/sem_util.adb | 1 - gcc/ada/sinfo-cn.adb | 55 - gcc/ada/sinfo-utils.ads | 12 +- gcc/ada/sinfo.ads | 2381 +++++++------- gcc/ada/treepr.adb | 196 +- gcc/ada/types.ads | 4 + 25 files changed, 4576 insertions(+), 4450 deletions(-) diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index d0b06bbce5e..8df2d7fc988 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -156,12 +156,12 @@ package body Atree is pragma Inline (Report); -- Invoke the reporting procedure if available - function Size_In_Slots (N : Node_Or_Entity_Id) return Field_Offset; + function Size_In_Slots (N : Node_Or_Entity_Id) return Slot_Count; -- Number of slots belonging to N. This can be less than -- Size_In_Slots_To_Alloc for entities. - function Size_In_Slots_To_Alloc (N : Node_Or_Entity_Id) return Field_Offset; - function Size_In_Slots_To_Alloc (Kind : Node_Kind) return Field_Offset; + function Size_In_Slots_To_Alloc (N : Node_Or_Entity_Id) return Slot_Count; + function Size_In_Slots_To_Alloc (Kind : Node_Kind) return Slot_Count; -- 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. @@ -172,27 +172,32 @@ package body Atree is function Off_L (N : Node_Id) return Node_Offset; -- Offset of the last slot of N in Slots.Table - procedure Zero_Slots (F, L : Node_Offset) with Inline; + procedure Zero_Slots (First, Last : Node_Offset) with Inline; -- Set slots in the range F..L to zero procedure Zero_Slots (N : Node_Or_Entity_Id) with Inline; -- Zero the slots belonging to N - procedure Copy_Slots (From, To, Num_Slots : Node_Offset) with Inline; - -- Copy Num_Slots slots from From to To + procedure Copy_Slots (From, To : Node_Offset; Num_Slots : Slot_Count) + with Inline; + -- Copy Num_Slots slots from From to To. Caller is responsible for ensuring + -- that the Num_Slots at To are a reasonable place to copy to. procedure Copy_Slots (Source, Destination : Node_Id) with Inline; - -- Copies the slots of Source to Destination + -- Copies the slots of Source to Destination; uses the node kind to + -- determine the Num_Slots. 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. + (N : Node_Id; Field : Node_Field) return Field_Size_32_Bit; + -- Get any field value as a Field_Size_32_Bit. If the field is smaller than + -- 32 bits, convert it to Field_Size_32_Bit. The Field must be present in + -- the Nkind of N. 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. + (N : Node_Id; Field : Node_Field; Val : Field_Size_32_Bit); + -- Set any field value as a Field_Size_32_Bit. If the field is smaller than + -- 32 bits, convert it from Field_Size_32_Bit, and Val had better be small + -- enough. The Field must be present in the Nkind of N. procedure Check_Vanishing_Fields (Old_N : Node_Id; New_Kind : Node_Kind); @@ -200,9 +205,9 @@ package body Atree is -- vanishing fields are in their initial zero state. function Get_Field_Value - (N : Entity_Id; Field : Entity_Field) return Field_32_Bit; + (N : Entity_Id; Field : Entity_Field) return Field_Size_32_Bit; procedure Set_Field_Value - (N : Entity_Id; Field : Entity_Field; Val : Field_32_Bit); + (N : Entity_Id; Field : Entity_Field; Val : Field_Size_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 @@ -213,17 +218,22 @@ package body Atree is -- Mutate_Nkind. procedure Mutate_Nkind - (N : Node_Id; Val : Node_Kind; Old_Size : Field_Offset); + (N : Node_Id; Val : Node_Kind; Old_Size : Slot_Count); -- Called by the other Mutate_Nkind to do all the work. This is needed -- because the call in Change_Node, which calls this one directly, happens -- after zeroing N's slots, which destroys its Nkind, which prevents us -- from properly computing Old_Size. package Field_Checking is + -- Functions for checking field access, used only in assertions + function Field_Present (Kind : Node_Kind; Field : Node_Field) return Boolean; function Field_Present (Kind : Entity_Kind; Field : Entity_Field) return Boolean; + -- True if a node/entity of the given Kind has the given Field. + -- Always True if assertions are disabled. + end Field_Checking; package body Field_Checking is @@ -240,16 +250,20 @@ package body Atree is procedure Init_Tables; - function Fields_Present (Kind : Node_Kind) return Node_Field_Set; - function Fields_Present (Kind : Entity_Kind) return Entity_Field_Set; + function Create_Node_Fields_Present + (Kind : Node_Kind) return Node_Field_Set; + function Create_Entity_Fields_Present + (Kind : Entity_Kind) return Entity_Field_Set; -- Computes the set of fields present in each Node/Entity Kind. Used to -- initialize the above tables. - -------------------- - -- Fields_Present -- - -------------------- + -------------------------------- + -- Create_Node_Fields_Present -- + -------------------------------- - function Fields_Present (Kind : Node_Kind) return Node_Field_Set is + function Create_Node_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 @@ -257,9 +271,15 @@ package body Atree is end loop; return Result; - end Fields_Present; + end Create_Node_Fields_Present; + + -------------------------------- + -- Create_Entity_Fields_Present -- + -------------------------------- - function Fields_Present (Kind : Entity_Kind) return Entity_Field_Set is + function Create_Entity_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 @@ -267,20 +287,25 @@ package body Atree is end loop; return Result; - end Fields_Present; + end Create_Entity_Fields_Present; + + ----------------- + -- Init_Tables -- + ----------------- procedure Init_Tables is begin Node_Fields_Present := new Node_Field_Sets; for Kind in Node_Kind loop - Node_Fields_Present (Kind) := Fields_Present (Kind); + Node_Fields_Present (Kind) := Create_Node_Fields_Present (Kind); end loop; Entity_Fields_Present := new Entity_Field_Sets; for Kind in Entity_Kind loop - Entity_Fields_Present (Kind) := Fields_Present (Kind); + Entity_Fields_Present (Kind) := + Create_Entity_Fields_Present (Kind); end loop; end Init_Tables; @@ -347,7 +372,8 @@ package body Atree is -- 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. + -- or unused padding at the end. The "_Write" version is used when we're + -- about to modify the node. procedure Validate_Node_And_Offset (N : Node_Or_Entity_Id; Offset : Field_Offset) is @@ -384,7 +410,7 @@ package body Atree is pragma Assert (N'Valid); pragma Assert (N <= Node_Offsets.Last); - pragma Assert (Off_0 (N) < Off_L (N)); + 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); @@ -393,15 +419,16 @@ package body Atree is pragma Assert (Ekind (N)'Valid); end if; - if Nkind (N) in N_Attribute_Definition_Clause - | N_Has_Entity - | N_Aggregate - | N_Extension_Aggregate - | N_Selected_Component - | N_Use_Package_Clause - | N_Aspect_Specification - | N_Freeze_Entity - | N_Freeze_Generic_Entity + if Nkind (N) in + N_Aggregate + | N_Attribute_Definition_Clause + | N_Aspect_Specification + | N_Extension_Aggregate + | N_Freeze_Entity + | N_Freeze_Generic_Entity + | N_Has_Entity + | N_Selected_Component + | N_Use_Package_Clause then pragma Assert (Entity_Or_Associated_Node (N)'Valid); end if; @@ -433,7 +460,7 @@ package body Atree is return Node_Offsets.Last; end Alloc_Node_Id; - function Alloc_Slots (Num_Slots : Field_Offset) return Node_Offset is + function Alloc_Slots (Num_Slots : Slot_Count) return Node_Offset is begin return Result : constant Node_Offset := Slots.Last + 1 do Slots.Set_Last (Slots.Last + Num_Slots); @@ -445,7 +472,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 1); - function Cast is new Unchecked_Conversion (Field_1_Bit, Field_Type); + function Cast is new + Unchecked_Conversion (Field_Size_1_Bit, Field_Type); begin return Cast (Get_1_Bit_Val (N, Offset)); end Get_1_Bit_Field; @@ -455,7 +483,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 2); - function Cast is new Unchecked_Conversion (Field_2_Bit, Field_Type); + function Cast is new + Unchecked_Conversion (Field_Size_2_Bit, Field_Type); begin return Cast (Get_2_Bit_Val (N, Offset)); end Get_2_Bit_Field; @@ -465,7 +494,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 4); - function Cast is new Unchecked_Conversion (Field_4_Bit, Field_Type); + function Cast is new + Unchecked_Conversion (Field_Size_4_Bit, Field_Type); begin return Cast (Get_4_Bit_Val (N, Offset)); end Get_4_Bit_Field; @@ -475,7 +505,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 8); - function Cast is new Unchecked_Conversion (Field_8_Bit, Field_Type); + function Cast is new + Unchecked_Conversion (Field_Size_8_Bit, Field_Type); begin return Cast (Get_8_Bit_Val (N, Offset)); end Get_8_Bit_Field; @@ -485,7 +516,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 32); - function Cast is new Unchecked_Conversion (Field_32_Bit, Field_Type); + function Cast is new + Unchecked_Conversion (Field_Size_32_Bit, Field_Type); begin return Cast (Get_32_Bit_Val (N, Offset)); end Get_32_Bit_Field; @@ -496,7 +528,8 @@ package body Atree 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. + -- That is of the "wrong" type, so we fetch it as a + -- Field_Size_32_Bit. if Get_32_Bit_Val (N, Offset) = 0 then return Default_Val; @@ -511,7 +544,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 1); - function Cast is new Unchecked_Conversion (Field_Type, Field_1_Bit); + function Cast is new + Unchecked_Conversion (Field_Type, Field_Size_1_Bit); begin Set_1_Bit_Val (N, Offset, Cast (Val)); end Set_1_Bit_Field; @@ -521,7 +555,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 2); - function Cast is new Unchecked_Conversion (Field_Type, Field_2_Bit); + function Cast is new + Unchecked_Conversion (Field_Type, Field_Size_2_Bit); begin Set_2_Bit_Val (N, Offset, Cast (Val)); end Set_2_Bit_Field; @@ -531,7 +566,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 4); - function Cast is new Unchecked_Conversion (Field_Type, Field_4_Bit); + function Cast is new + Unchecked_Conversion (Field_Type, Field_Size_4_Bit); begin Set_4_Bit_Val (N, Offset, Cast (Val)); end Set_4_Bit_Field; @@ -541,7 +577,8 @@ package body Atree is is pragma Assert (Field_Type'Size = 8); - function Cast is new Unchecked_Conversion (Field_Type, Field_8_Bit); + function Cast is new + Unchecked_Conversion (Field_Type, Field_Size_8_Bit); begin Set_8_Bit_Val (N, Offset, Cast (Val)); end Set_8_Bit_Field; @@ -551,13 +588,14 @@ package body Atree is is pragma Assert (Field_Type'Size = 32); - function Cast is new Unchecked_Conversion (Field_Type, Field_32_Bit); + function Cast is new + Unchecked_Conversion (Field_Type, Field_Size_32_Bit); begin Set_32_Bit_Val (N, Offset, Cast (Val)); end Set_32_Bit_Field; function Get_1_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_1_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_1_Bit is -- We wish we were using packed arrays, but instead we're simulating -- them with modular integers. L here (and elsewhere) is the 'Length @@ -569,11 +607,11 @@ package body Atree is S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); V : constant Natural := Natural ((Offset mod L) * (Slot_Size / L)); begin - return Field_1_Bit (Shift_Right (S, V) and 1); + return Field_Size_1_Bit (Shift_Right (S, V) and 1); end Get_1_Bit_Val; function Get_2_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_2_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_2_Bit is L : constant Field_Offset := Slot_Size / 2; @@ -582,11 +620,11 @@ package body Atree is S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); V : constant Natural := Natural ((Offset mod L) * (Slot_Size / L)); begin - return Field_2_Bit (Shift_Right (S, V) and 3); + return Field_Size_2_Bit (Shift_Right (S, V) and 3); end Get_2_Bit_Val; function Get_4_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_4_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_4_Bit is L : constant Field_Offset := Slot_Size / 4; @@ -595,11 +633,11 @@ package body Atree is S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); V : constant Natural := Natural ((Offset mod L) * (Slot_Size / L)); begin - return Field_4_Bit (Shift_Right (S, V) and 15); + return Field_Size_4_Bit (Shift_Right (S, V) and 15); end Get_4_Bit_Val; function Get_8_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_8_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_8_Bit is L : constant Field_Offset := Slot_Size / 8; @@ -608,21 +646,21 @@ package body Atree is S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset / L); V : constant Natural := Natural ((Offset mod L) * (Slot_Size / L)); begin - return Field_8_Bit (Shift_Right (S, V) and 255); + return Field_Size_8_Bit (Shift_Right (S, V) and 255); end Get_8_Bit_Val; function Get_32_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_32_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_32_Bit is pragma Debug (Validate_Node_And_Offset (N, Offset)); S : Slot renames Slots.Table (Node_Offsets.Table (N) + Offset); begin - return Field_32_Bit (S); + return Field_Size_32_Bit (S); end Get_32_Bit_Val; procedure Set_1_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_1_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_1_Bit) is L : constant Field_Offset := Slot_Size / 1; @@ -635,7 +673,7 @@ package body Atree is end Set_1_Bit_Val; procedure Set_2_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_2_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_2_Bit) is L : constant Field_Offset := Slot_Size / 2; @@ -648,7 +686,7 @@ package body Atree is end Set_2_Bit_Val; procedure Set_4_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_4_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_4_Bit) is L : constant Field_Offset := Slot_Size / 4; @@ -661,7 +699,7 @@ package body Atree is end Set_4_Bit_Val; procedure Set_8_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_8_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_8_Bit) is L : constant Field_Offset := Slot_Size / 8; @@ -674,7 +712,7 @@ package body Atree is end Set_8_Bit_Val; procedure Set_32_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_32_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_32_Bit) is pragma Debug (Validate_Node_And_Offset_Write (N, Offset)); @@ -695,33 +733,33 @@ package body Atree is -- etc. function Get_Field_Value - (N : Node_Id; Field : Node_Field) return Field_32_Bit + (N : Node_Id; Field : Node_Field) return Field_Size_32_Bit is pragma Assert (Field_Checking.Field_Present (Nkind (N), Field)); Desc : Field_Descriptor renames Node_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 1 => return Field_Size_32_Bit (Get_1_Bit_Val (N, Desc.Offset)); + when 2 => return Field_Size_32_Bit (Get_2_Bit_Val (N, Desc.Offset)); + when 4 => return Field_Size_32_Bit (Get_4_Bit_Val (N, Desc.Offset)); + when 8 => return Field_Size_32_Bit (Get_8_Bit_Val (N, Desc.Offset)); when others => return Get_32_Bit_Val (N, Desc.Offset); -- 32 end case; end Get_Field_Value; procedure Set_Field_Value - (N : Node_Id; Field : Node_Field; Val : Field_32_Bit) + (N : Node_Id; Field : Node_Field; Val : Field_Size_32_Bit) is pragma Assert (Field_Checking.Field_Present (Nkind (N), Field)); Desc : Field_Descriptor renames Node_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 1 => Set_1_Bit_Val (N, Desc.Offset, Field_Size_1_Bit (Val)); + when 2 => Set_2_Bit_Val (N, Desc.Offset, Field_Size_2_Bit (Val)); + when 4 => Set_4_Bit_Val (N, Desc.Offset, Field_Size_4_Bit (Val)); + when 8 => Set_8_Bit_Val (N, Desc.Offset, Field_Size_8_Bit (Val)); when others => Set_32_Bit_Val (N, Desc.Offset, Val); -- 32 end case; end Set_Field_Value; @@ -784,31 +822,31 @@ package body Atree is end Check_Vanishing_Fields; function Get_Field_Value - (N : Entity_Id; Field : Entity_Field) return Field_32_Bit + (N : Entity_Id; Field : Entity_Field) return Field_Size_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 1 => return Field_Size_32_Bit (Get_1_Bit_Val (N, Desc.Offset)); + when 2 => return Field_Size_32_Bit (Get_2_Bit_Val (N, Desc.Offset)); + when 4 => return Field_Size_32_Bit (Get_4_Bit_Val (N, Desc.Offset)); + when 8 => return Field_Size_32_Bit (Get_8_Bit_Val (N, Desc.Offset)); when others => return Get_32_Bit_Val (N, Desc.Offset); -- 32 end case; end Get_Field_Value; procedure Set_Field_Value - (N : Entity_Id; Field : Entity_Field; Val : Field_32_Bit) + (N : Entity_Id; Field : Entity_Field; Val : Field_Size_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 1 => Set_1_Bit_Val (N, Desc.Offset, Field_Size_1_Bit (Val)); + when 2 => Set_2_Bit_Val (N, Desc.Offset, Field_Size_2_Bit (Val)); + when 4 => Set_4_Bit_Val (N, Desc.Offset, Field_Size_4_Bit (Val)); + when 8 => Set_8_Bit_Val (N, Desc.Offset, Field_Size_8_Bit (Val)); when others => Set_32_Bit_Val (N, Desc.Offset, Val); -- 32 end case; end Set_Field_Value; @@ -864,18 +902,18 @@ package body Atree is Nkind_Offset : constant Field_Offset := Node_Field_Descriptors (Nkind).Offset; - procedure Set_Nkind_Type is new Set_8_Bit_Field (Node_Kind) with Inline; + procedure Set_Node_Kind_Type is new Set_8_Bit_Field (Node_Kind) with Inline; procedure Init_Nkind (N : Node_Id; Val : Node_Kind) is pragma Assert (Field_Is_Initial_Zero (N, Nkind)); begin - Set_Nkind_Type (N, Nkind_Offset, Val); + Set_Node_Kind_Type (N, Nkind_Offset, Val); end Init_Nkind; procedure Mutate_Nkind - (N : Node_Id; Val : Node_Kind; Old_Size : Field_Offset) + (N : Node_Id; Val : Node_Kind; Old_Size : Slot_Count) is - New_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Val); + New_Size : constant Slot_Count := Size_In_Slots_To_Alloc (Val); All_Node_Offsets : Node_Offsets.Table_Type renames Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); @@ -905,7 +943,7 @@ package body Atree is Zero_Slots (Off_0 (N) + Old_Size, Slots.Last); end if; - Set_Nkind_Type (N, Nkind_Offset, Val); + Set_Node_Kind_Type (N, Nkind_Offset, Val); pragma Debug (Validate_Node_Write (N)); end Mutate_Nkind; @@ -917,7 +955,8 @@ package body Atree is Ekind_Offset : constant Field_Offset := Entity_Field_Descriptors (Ekind).Offset; - procedure Set_Ekind_Type is new Set_8_Bit_Field (Entity_Kind) with Inline; + procedure Set_Entity_Kind_Type is new Set_8_Bit_Field (Entity_Kind) + with Inline; procedure Mutate_Ekind (N : Entity_Id; Val : Entity_Kind) @@ -934,7 +973,7 @@ package body Atree is -- For now, we are allocating all entities with the same size, so we -- don't need to reallocate slots here. - Set_Ekind_Type (N, Ekind_Offset, Val); + Set_Entity_Kind_Type (N, Ekind_Offset, Val); pragma Debug (Validate_Node_Write (N)); end Mutate_Ekind; @@ -946,7 +985,7 @@ package body Atree is begin return Result : constant Node_Id := Alloc_Node_Id do declare - Sz : constant Field_Offset := Size_In_Slots_To_Alloc (Kind); + Sz : constant Slot_Count := Size_In_Slots_To_Alloc (Kind); Sl : constant Node_Offset := Alloc_Slots (Sz); begin Node_Offsets.Table (Result) := Sl; @@ -988,15 +1027,15 @@ package body Atree is pragma Assert (Nkind (N) not in N_Entity); pragma Assert (New_Kind not in N_Entity); - Old_Size : constant Field_Offset := Size_In_Slots (N); - New_Size : constant Field_Offset := Size_In_Slots_To_Alloc (New_Kind); + Old_Size : constant Slot_Count := Size_In_Slots (N); + New_Size : constant Slot_Count := 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_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; @@ -1034,11 +1073,11 @@ package body Atree is end if; end Change_Node; - --------------- - -- Copy_Node -- - --------------- + ---------------- + -- Copy_Slots -- + ---------------- - procedure Copy_Slots (From, To, Num_Slots : Node_Offset) is + procedure Copy_Slots (From, To : Node_Offset; Num_Slots : Slot_Count) is pragma Assert (From /= To); All_Slots : Slots.Table_Type renames @@ -1059,7 +1098,7 @@ package body Atree is pragma Debug (Validate_Node_Write (Destination)); pragma Assert (Source /= Destination); - S_Size : constant Field_Offset := Size_In_Slots (Source); + S_Size : constant Slot_Count := Size_In_Slots (Source); All_Node_Offsets : Node_Offsets.Table_Type renames Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); @@ -1079,8 +1118,8 @@ package body Atree is Save_In_List : constant Boolean := In_List (Destination); Save_Link : constant Union_Id := Link (Destination); - S_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Source); - D_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Destination); + S_Size : constant Slot_Count := Size_In_Slots_To_Alloc (Source); + D_Size : constant Slot_Count := Size_In_Slots_To_Alloc (Destination); begin New_Node_Debugging_Output (Source); @@ -1350,7 +1389,7 @@ package body Atree 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 + when others => N_Unused_At_Start); -- 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); @@ -1554,54 +1593,51 @@ package body Atree is function New_Copy (Source : Node_Id) return Node_Id is pragma Debug (Validate_Node (Source)); - - New_Id : Node_Id; - S_Size : constant Field_Offset := Size_In_Slots_To_Alloc (Source); + S_Size : constant Slot_Count := Size_In_Slots_To_Alloc (Source); begin if Source <= Empty_Or_Error then return Source; end if; - New_Id := Alloc_Node_Id; - Node_Offsets.Table (New_Id) := Alloc_Slots (S_Size); - Orig_Nodes.Append (New_Id); - Copy_Slots (Source, New_Id); + return New_Id : constant Node_Id := Alloc_Node_Id do + Node_Offsets.Table (New_Id) := Alloc_Slots (S_Size); + Orig_Nodes.Append (New_Id); + Copy_Slots (Source, New_Id); - Set_Check_Actuals (New_Id, False); - Set_Paren_Count_Of_Copy (Target => New_Id, Source => Source); - pragma Assert (Original_Node (Node_Offsets.Last) = Node_Offsets.Last); + Set_Check_Actuals (New_Id, False); + Set_Paren_Count_Of_Copy (Target => New_Id, Source => Source); - Allocate_List_Tables (New_Id); - Report (Target => New_Id, Source => Source); + Allocate_List_Tables (New_Id); + Report (Target => New_Id, Source => Source); - Set_In_List (New_Id, False); - Set_Link (New_Id, Empty_List_Or_Node); + Set_In_List (New_Id, False); + Set_Link (New_Id, Empty_List_Or_Node); - -- If the original is marked as a rewrite insertion, then unmark the - -- copy, since we inserted the original, not the copy. + -- If the original is marked as a rewrite insertion, then unmark the + -- copy, since we inserted the original, not the copy. - Set_Rewrite_Ins (New_Id, False); + Set_Rewrite_Ins (New_Id, False); - -- Clear Is_Overloaded since we cannot have semantic interpretations - -- of this new node. + -- Clear Is_Overloaded since we cannot have semantic interpretations + -- of this new node. - if Nkind (Source) in N_Subexpr then - Set_Is_Overloaded (New_Id, False); - end if; + if Nkind (Source) in N_Subexpr then + Set_Is_Overloaded (New_Id, False); + end if; - -- Always clear Has_Aspects, the caller must take care of copying - -- aspects if this is required for the particular situation. + -- Always clear Has_Aspects, the caller must take care of copying + -- aspects if this is required for the particular situation. - Set_Has_Aspects (New_Id, False); + Set_Has_Aspects (New_Id, False); - -- Mark the copy as Ghost depending on the current Ghost region + -- Mark the copy as Ghost depending on the current Ghost region - Mark_New_Ghost_Node (New_Id); + Mark_New_Ghost_Node (New_Id); - New_Node_Debugging_Output (New_Id); + New_Node_Debugging_Output (New_Id); - pragma Assert (New_Id /= Source); - return New_Id; + pragma Assert (New_Id /= Source); + end return; end New_Copy; ---------------- @@ -1684,10 +1720,9 @@ package body Atree is return Node_Offsets.Table (First_Node_Id)'Address; end Node_Offsets_Address; - Slot_Byte_Size : constant := 4; - pragma Assert (Slot_Byte_Size * 8 = Slot'Size); - function Slots_Address return System.Address is + Slot_Byte_Size : constant := 4; + pragma Assert (Slot_Byte_Size * 8 = Slot'Size); 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 @@ -2123,7 +2158,7 @@ package body Atree is Rewriting_Proc := Proc; end Set_Rewriting_Proc; - function Size_In_Slots_To_Alloc (Kind : Node_Kind) return Field_Offset is + function Size_In_Slots_To_Alloc (Kind : Node_Kind) return Slot_Count is begin return (if Kind in N_Entity then Einfo.Entities.Max_Entity_Size @@ -2133,12 +2168,12 @@ package body Atree is end Size_In_Slots_To_Alloc; function Size_In_Slots_To_Alloc - (N : Node_Or_Entity_Id) return Field_Offset is + (N : Node_Or_Entity_Id) return Slot_Count is begin return Size_In_Slots_To_Alloc (Nkind (N)); end Size_In_Slots_To_Alloc; - function Size_In_Slots (N : Node_Or_Entity_Id) return Field_Offset is + function Size_In_Slots (N : Node_Or_Entity_Id) return Slot_Count is begin pragma Assert (Nkind (N) /= N_Unused_At_Start); return @@ -2313,11 +2348,9 @@ package body Atree is -- Zero_Slots -- ---------------- - Zero : constant Slot := 0; - - procedure Zero_Slots (F, L : Node_Offset) is + procedure Zero_Slots (First, Last : Node_Offset) is begin - Slots.Table (F .. L) := (others => Zero); + Slots.Table (First .. Last) := (others => 0); end Zero_Slots; procedure Zero_Slots (N : Node_Or_Entity_Id) is diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index c814c80cefa..352275315a5 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -549,6 +549,18 @@ package Atree is -- a manner that can be reversed later). One possible approach is to use -- Rewrite to substitute a null statement for the node to be deleted. + ---------------------- + -- Vanishing Fields -- + ---------------------- + + -- The Nkind and Ekind fields are like Ada discriminants governing a + -- variant part. They determine which fields are present. If the Nkind + -- or Ekind fields are changed, then this can change which fields are + -- present. If a field is present for the old kind, but not for the + -- new kind, the field vanishes. This requires some care when changing + -- kinds, as described below. Note that Ada doesn't even allow direct + -- modification of a discriminant. + type Node_Field_Set is array (Node_Field) of Boolean with Pack; type Entity_Field_Set is array (Entity_Field) of Boolean with Pack; @@ -594,9 +606,9 @@ package Atree is -- 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 + -- else" fields to retain their value. The 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. + -- E_Void, to E_Constant. procedure Print_Atree_Info (N : Node_Or_Entity_Id); -- Called from Treepr to print out information about N that is private to @@ -648,6 +660,13 @@ package Atree is Table_Increment => Alloc.Node_Offsets_Increment, Table_Name => "Node_Offsets"); + Noff : Node_Offsets.Table_Ptr renames Node_Offsets.Table with + Unreferenced; + function Nlast return Node_Id'Base renames Node_Offsets.Last with + Unreferenced; + -- Short names for use in gdb, not used in real code. Note that gdb + -- can't find Node_Offsets.Table without a full expanded name. + -- We define the type Slot as a 32-bit modular integer. It is logically -- split into the appropriate numbers of components of appropriate size, -- but this splitting is not explicit because packed arrays cannot be @@ -663,11 +682,15 @@ package Atree is function Shift_Right (S : Slot; V : Natural) return Slot; pragma Import (Intrinsic, Shift_Right); - type Field_1_Bit is mod 2**1; - type Field_2_Bit is mod 2**2; - type Field_4_Bit is mod 2**4; - type Field_8_Bit is mod 2**8; - type Field_32_Bit is mod 2**32; + -- Low-level types for fields of the various supported sizes. + -- All fields are a power of 2 number of bits, and are aligned + -- to that number of bits: + + type Field_Size_1_Bit is mod 2**1; + type Field_Size_2_Bit is mod 2**2; + type Field_Size_4_Bit is mod 2**4; + type Field_Size_8_Bit is mod 2**8; + type Field_Size_32_Bit is mod 2**32; Slots_Low_Bound : constant Field_Offset := Field_Offset'First + 1; @@ -681,22 +704,25 @@ package Atree is -- 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. + Slts : Slots.Table_Ptr renames Slots.Table with + Unreferenced; + function Slast return Node_Offset'Base renames Slots.Last with + Unreferenced; + -- Short names for use in gdb, not used in real code. Note that gdb + -- can't find Slots.Table without a full expanded name. function Alloc_Node_Id return Node_Id with Inline; - function Alloc_Slots (Num_Slots : Field_Offset) return Node_Offset + function Alloc_Slots (Num_Slots : Slot_Count) return Node_Offset with Inline; + -- Allocate the slots for a node in the Slots table -- 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. + -- Set_N_Bit_Field procedures. These are instantiated in Sinfo.Nodes and + -- Einfo.Entities for the various possible Field_Types (Flag, Node_Id, + -- Uint, etc). generic type Field_Type is private; @@ -771,49 +797,55 @@ package Atree is -- overloaded, we would use the same names. function Get_1_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_1_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_1_Bit with Inline; function Get_2_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_2_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_2_Bit with Inline; function Get_4_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_4_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_4_Bit with Inline; function Get_8_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_8_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_8_Bit with Inline; function Get_32_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_32_Bit + (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_32_Bit with Inline; procedure Set_1_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_1_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_1_Bit) with Inline; procedure Set_2_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_2_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_2_Bit) with Inline; procedure Set_4_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_4_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_4_Bit) with Inline; procedure Set_8_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_8_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_8_Bit) with Inline; procedure Set_32_Bit_Val - (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_32_Bit) + (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_32_Bit) with Inline; + -- The following are used in "asserts on" mode to validate nodes; an + -- exception is raised if invalid node content is detected. + procedure Validate_Node (N : Node_Or_Entity_Id); + -- Validate for reading procedure Validate_Node_Write (N : Node_Or_Entity_Id); + -- Validate for writing function Is_Valid_Node (U : Union_Id) return Boolean; + -- True if U is within the range of Node_Offsets end Atree_Private_Part; diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index f0dbf9c27d4..0ed7c74f59e 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -43,6 +43,24 @@ package body Einfo.Utils is -- Determine whether abstract state State_Id has particular option denoted -- by the name Option_Nam. + ----------------------------------- + -- Renamings of Renamed_Or_Alias -- + ----------------------------------- + + function Alias (N : Entity_Id) return Node_Id is + begin + pragma Assert + (Is_Overloadable (N) or else Ekind (N) = E_Subprogram_Type); + return Renamed_Or_Alias (N); + end Alias; + + procedure Set_Alias (N : Entity_Id; Val : Node_Id) is + begin + pragma Assert + (Is_Overloadable (N) or else Ekind (N) = E_Subprogram_Type); + Set_Renamed_Or_Alias (N, Val); + end Set_Alias; + ---------------- -- Has_Option -- ---------------- @@ -253,8 +271,7 @@ package body Einfo.Utils is function Is_Named_Access_Type (Id : E) return B is begin - return Ekind (Id) in E_Access_Type .. -- ???? - E_Access_Protected_Subprogram_Type; + return Ekind (Id) in Named_Access_Kind; end Is_Named_Access_Type; function Is_Named_Number (Id : E) return B is @@ -1425,8 +1442,6 @@ package body Einfo.Utils is 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; @@ -3123,17 +3138,6 @@ package body Einfo.Utils is 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 diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads index 1b32a4577a4..f305235fb6e 100644 --- a/gcc/ada/einfo-utils.ads +++ b/gcc/ada/einfo-utils.ads @@ -34,12 +34,10 @@ package Einfo.Utils is -- 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. + -- Alias isn't really renamed, because we want an assertion in the body. - 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 Alias (N : Entity_Id) return Node_Id; + procedure Set_Alias (N : Entity_Id; Val : Node_Id); function Renamed_Entity (N : Entity_Id) return Node_Id renames Renamed_Or_Alias; procedure Set_Renamed_Entity @@ -49,26 +47,19 @@ package Einfo.Utils is 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. + pragma Inline (Alias); + pragma Inline (Set_Alias); + pragma Inline (Renamed_Entity); + pragma Inline (Set_Renamed_Entity); + pragma Inline (Renamed_Object); + pragma Inline (Set_Renamed_Object); ------------------- -- 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.???? + -- procedure declarations that follow. subtype B is Boolean; subtype C is Component_Alignment_Kind; @@ -91,7 +82,6 @@ package Einfo.Utils is -- 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; @@ -220,6 +210,7 @@ package Einfo.Utils is 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; + -- Note that Is_Base_Type returns True for nontypes function Is_Boolean_Type (Id : E) return B; function Is_Constant_Object (Id : E) return B; function Is_Controlled (Id : E) return B; @@ -402,7 +393,11 @@ package Einfo.Utils is -- Access to Subprograms in Subprograms_For_Type -- --------------------------------------------------- - function Is_Partial_DIC_Procedure (Id : E) return B; + -- Now that we have variable-sized nodes, it might be possible to replace + -- the following with regular fields, and get rid of the flags used to mark + -- these kinds of subprograms. + + function Is_Partial_DIC_Procedure (Id : E) return B; function DIC_Procedure (Id : E) return E; function Partial_DIC_Procedure (Id : E) return E; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 362e665b372..fe9bf72898a 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -24,11 +24,11 @@ ------------------------------------------------------------------------------ pragma Warnings (Off); -- with/use clauses for children -with Namet; use Namet; +with Namet; use Namet; with Snames; use Snames; -with Stand; use Stand; -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); @@ -41,11 +41,6 @@ package Einfo is -- Note that the official definition of what entities have what fields is in -- Gen_IL.Gen.Gen_Entities; if there is a discrepancy between that and the -- comments here, Gen_IL.Gen.Gen_Entities wins. --- --- Offsets of each field are given in parentheses below, but this information --- is obsolete, and should be completely ignored. The actual field offsets are --- determined by the Gen_IL program. We might want to remove these comments at --- some point. -- These annotations are for the most part attributes of declared entities, -- and they correspond to conventional symbol table information. Other @@ -289,14 +284,22 @@ package Einfo is -- type. The attribute can be referenced on a subtype (and automatically -- retrieves the value from the implementation base type). However, it is an -- error to try to set the attribute on other than the implementation base --- type, and if assertions are enabled, an attempt to set the attribute on a --- subtype will raise an assert error. +-- type. + +-- Other attributes are noted as applying to the [root type only]. The +-- attribute can be referenced on a subtype (and automatically retrieves the +-- value from the root type). However, it is an error to try to set the +-- attribute on other than the root type. + +-- The definitive definition of what is [... type only] is in Gen_Entities. +-- See calls to Sm passing Base_Type_Only, Impl_Base_Type_Only, or +-- Root_Type_Only. --- Abstract_States (Elist25) +-- Abstract_States -- Defined for E_Package entities. Contains a list of all the abstract -- states declared by the related package. --- Accept_Address (Elist21) +-- Accept_Address -- Defined in entries. If an accept has a statement sequence, then an -- address variable is created, which is used to hold the address of the -- parameters, as passed by the runtime. Accept_Address holds an element @@ -305,7 +308,7 @@ package Einfo is -- on the list. A stack is required to handle the case of nested select -- statements referencing the same entry. --- Access_Disp_Table (Elist16) [implementation base type only] +-- Access_Disp_Table [implementation base type only] -- Defined in E_Record_Type and E_Record_Subtype entities. Set in tagged -- types to point to their dispatch tables. The first two entities are -- associated with the primary dispatch table: 1) primary dispatch table @@ -319,7 +322,7 @@ package Einfo is -- used to expand dispatching calls through the primary dispatch table. -- For an untagged record, contains No_Elist. --- Access_Disp_Table_Elab_Flag (Node30) [implementation base type only] +-- Access_Disp_Table_Elab_Flag [implementation base type only] -- Defined in E_Record_Type and E_Record_Subtype entities. Set in tagged -- types whose dispatch table elaboration must be completed at run time -- by the IP routine to point to its pending elaboration flag entity. @@ -327,7 +330,7 @@ package Einfo is -- on attribute 'Position applied to an object of the type; it is used by -- the IP routine to avoid performing this elaboration twice. --- Access_Subprogram_Wrapper (Node41) +-- Access_Subprogram_Wrapper -- Entity created for access_to_subprogram types that have pre/post -- conditions. Wrapper subprogram is created when analyzing corresponding -- aspect, and inherits said aspects. Body of subprogram includes code @@ -336,13 +339,13 @@ package Einfo is -- The Subprogram_Type created for the Access_To_Subprogram carries the -- Access_Subprogram_Wrapper for use in the expansion of indirect calls. --- Activation_Record_Component (Node31) +-- Activation_Record_Component -- Defined for E_Variable, E_Constant, E_Loop_Parameter, and formal -- parameter entities. Used in Opt.Unnest_Subprogram_Mode, in which case -- a reference to an uplevel entity produces a corresponding component -- in the generated ARECnT activation record (Exp_Unst for details). --- Actual_Subtype (Node17) +-- Actual_Subtype -- Defined in variables, constants, and formal parameters. This is the -- subtype imposed by the value of the object, as opposed to its nominal -- subtype, which is imposed by the declaration. The actual subtype @@ -368,7 +371,7 @@ package Einfo is -- defined before the entity to which the address clause applies. -- Note: The backend references this field in E_Task_Type entities??? --- Address_Taken (Flag104) +-- Address_Taken -- Defined in all entities. Set if the Address or Unrestricted_Access -- attribute is applied directly to the entity, i.e. the entity is the -- entity of the prefix of the attribute reference. Also set if the @@ -385,7 +388,7 @@ package Einfo is -- needed after the decimal point to accommodate the delta of the type, -- unless the delta is greater than 0.1, in which case it is 1. --- Alias (Node18) +-- Alias -- Defined in overloadable entities (literals, subprograms, entries) and -- subprograms that cover a primitive operation of an abstract interface -- (that is, subprograms with the Interface_Alias attribute). In case of @@ -399,7 +402,7 @@ package Einfo is -- non-dispatching, and a call from inside calls the overriding operation -- because it hides the implicit one. Alias is always empty for entries. --- Alignment (Uint14) +-- Alignment -- Defined in entities for types and also in constants, variables -- (including exceptions where it refers to the static data allocated for -- an exception), loop parameters, and formal parameters. This indicates @@ -422,32 +425,32 @@ package Einfo is -- definition clause with an (obsolescent) mod clause is converted -- into an attribute definition clause for this purpose. --- Anonymous_Designated_Type (Node35) +-- Anonymous_Designated_Type -- Defined in variables which represent anonymous finalization masters. -- Contains the designated type which is being serviced by the master. --- Anonymous_Masters (Elist29) +-- Anonymous_Masters -- Defined in packages, subprograms, and subprogram bodies. Contains a -- list of anonymous finalization masters declared within the related -- unit. The list acts as a mapping between a master and a designated -- type. --- Anonymous_Object (Node30) +-- Anonymous_Object -- Present in protected and task type entities. Contains the entity of -- the anonymous object created for a single protected or task type. --- Associated_Entity (Node37) +-- Associated_Entity -- Defined in all entities. This field is similar to Associated_Node, but -- applied to entities. The attribute links an entity from the generic -- template with its corresponding entity in the analyzed generic copy. -- The global references mechanism relies on the Associated_Entity to -- infer the context. --- Associated_Formal_Package (Node12) +-- Associated_Formal_Package -- Defined in packages that are the actuals of formal_packages. Points -- to the entity in the declaration for the formal package. --- Associated_Node_For_Itype (Node8) +-- Associated_Node_For_Itype -- Defined in all type and subtype entities. Set non-Empty only for -- Itypes. Set to point to the associated node for the Itype, i.e. -- the node whose elaboration generated the Itype. This is used for @@ -469,14 +472,14 @@ package Einfo is -- Itype is the only way to determine the construct that leads to the -- creation of a given itype entity. --- Associated_Storage_Pool (Node22) [root type only] +-- Associated_Storage_Pool [root type only] -- Defined in simple and general access type entities. References the -- storage pool to be used for the corresponding collection. A value of -- Empty means that the default pool is to be used. This is defined -- only in the root type, since derived types must have the same pool -- as the parent type. --- Barrier_Function (Node12) +-- Barrier_Function -- Defined in protected entries and entry families. This is the -- subprogram declaration for the body of the function that returns -- the value of the entry barrier. @@ -492,7 +495,7 @@ package Einfo is -- apply Base_Type to other than a type, in which case it simply returns -- the entity unchanged. --- Block_Node (Node11) +-- Block_Node -- Defined in block entities. Points to the identifier in the -- Block_Statement itself. Used when retrieving the block construct -- for finalization purposes, the block entity has an implicit label @@ -502,16 +505,16 @@ package Einfo is -- and not to the block_statement itself, because the statement may -- be rewritten, e.g. in the process of removing dead code. --- Body_Entity (Node19) +-- Body_Entity -- Defined in package and generic package entities, points to the -- corresponding package body entity if one is present. --- Body_Needed_For_SAL (Flag40) +-- Body_Needed_For_SAL -- Defined in package and subprogram entities that are compilation -- units. Indicates that the source for the body must be included -- when the unit is part of a standalone library. --- Body_Needed_For_Inlining (Flag299) +-- Body_Needed_For_Inlining -- Defined in package entities that are compilation units. Used to -- determine whether the body unit needs to be compiled when the -- package declaration appears in the list of units to inline. A body @@ -519,13 +522,13 @@ package Einfo is -- functions that carry pragma Inline or Inline_Always, or if it -- contains a generic unit that requires a body. -- --- Body_References (Elist16) +-- Body_References -- Defined in abstract state entities. Contains an element list of -- references (identifiers) that appear in a package body whose spec -- defines the related state. If the body refines the said state, all -- references on this list are illegal due to the visible refinement. --- BIP_Initialization_Call (Node29) +-- BIP_Initialization_Call -- Defined in constants and variables whose corresponding declaration -- is wrapped in a transient block and the inital value is provided by -- a build-in-place function call. Contains the relocated build-in-place @@ -533,7 +536,7 @@ package Einfo is -- attribute is used by the finalization machinery to insert cleanup code -- for all additional transient objects found in the transient block. --- C_Pass_By_Copy (Flag125) [implementation base type only] +-- C_Pass_By_Copy [implementation base type only] -- Defined in record types. Set if a pragma Convention for the record -- type specifies convention C_Pass_By_Copy. This convention name is -- treated as identical in all respects to convention C, except that @@ -543,7 +546,7 @@ package Einfo is -- set to By_Copy (unless specifically overridden by an Import or -- Export pragma). --- Can_Never_Be_Null (Flag38) +-- Can_Never_Be_Null -- This flag is defined in all entities. It is set in an object which can -- never have a null value. Set for constant access values initialized to -- a non-null value. This is also set for all access parameters in Ada 83 @@ -558,7 +561,7 @@ package Einfo is -- This is also set on some access types, e.g. the Etype of the anonymous -- access type of a controlling formal. --- Can_Use_Internal_Rep (Flag229) [base type only] +-- Can_Use_Internal_Rep [base type only] -- Defined in Access_Subprogram_Kind nodes. This flag is set by the -- front end and used by the backend. False means that the backend -- must represent the type in the same way as Convention-C types (and @@ -589,7 +592,7 @@ package Einfo is -- to have Can_Use_Internal_Rep False for an access type, but allow P to -- have convention Ada. --- Chars (Name1) +-- Chars -- Defined in all entities. This field contains an entry into the names -- table that has the character string of the identifier, character -- literal or operator symbol. See Namet for further details. Note that @@ -600,26 +603,26 @@ package Einfo is -- point (including post backend steps, e.g. cross-reference generation), -- the entities will contain the encoded qualified names. --- Checks_May_Be_Suppressed (Flag31) +-- Checks_May_Be_Suppressed -- Defined in all entities. Set if a pragma Suppress or Unsuppress -- mentions the entity specifically in the second argument. If this -- flag is set the Global_Entity_Suppress and Local_Entity_Suppress -- tables must be consulted to determine if there actually is an active -- Suppress or Unsuppress pragma that applies to the entity. --- Class_Wide_Clone (Node38) +-- Class_Wide_Clone -- Defined on subprogram entities. Set if the subprogram has a class-wide -- ore- or postcondition, and the expression contains calls to other -- primitive funtions of the type. Used to implement properly the -- semantics of inherited operations whose class-wide condition may -- be different from that of the ancestor (See AI012-0195). --- Class_Wide_Type (Node9) +-- Class_Wide_Type -- Defined in all type entities. For a tagged type or subtype, returns -- the corresponding implicitly declared class-wide type. For a -- class-wide type, returns itself. Set to Empty for untagged types. --- Cloned_Subtype (Node16) +-- Cloned_Subtype -- Defined in E_Record_Subtype and E_Class_Wide_Subtype entities. -- Each such entity can either have a Discriminant_Constraint, in -- which case it represents a distinct type from the base type (and @@ -655,7 +658,7 @@ package Einfo is -- the Component_Alignment pragma. Note: this field is currently -- stored in a non-standard way, see body for details. --- Component_Bit_Offset (Uint11) +-- Component_Bit_Offset -- Defined in record components (E_Component, E_Discriminant). First -- bit position of given component, computed from the first bit and -- position values given in the component clause. A value of No_Uint @@ -673,7 +676,7 @@ package Einfo is -- be eliminated, but it is convenient in several situations, including -- use in the backend, to have this redundant field. --- Component_Clause (Node13) +-- Component_Clause -- Defined in record components and discriminants. If a record -- representation clause is present for the corresponding record type a -- that specifies a position for the component, then the Component_Clause @@ -681,7 +684,7 @@ package Einfo is -- Set to Empty if no record representation clause was present, or if -- there was no specification for this component. --- Component_Size (Uint22) [implementation base type only] +-- Component_Size [implementation base type only] -- Defined in array types. It contains the component size value for -- the array. A value of No_Uint means that the value is not yet set. -- The value can be set by the use of a component size clause, or @@ -691,56 +694,56 @@ package Einfo is -- of the component has a variable length size). See package Layout -- for details of these values. --- Component_Type (Node20) [implementation base type only] +-- Component_Type [implementation base type only] -- Defined in array types and string types. References component type. --- Contains_Ignored_Ghost_Code (Flag279) +-- Contains_Ignored_Ghost_Code -- Defined in blocks, packages and their bodies, subprograms and their -- bodies. Set if the entity contains any ignored Ghost code in the form -- of declaration, procedure call, assignment statement or pragma. --- Contract (Node34) +-- Contract -- Defined in constant, entry, entry family, operator, [generic] package, -- package body, protected unit, [generic] subprogram, subprogram body, -- variable, task unit, and type entities. Points to the contract of the -- entity, holding various assertion items and data classifiers. --- Contract_Wrapper (Node25) +-- Contract_Wrapper -- Defined in entry and entry family entities. Set only when the entry -- [family] has contract cases, preconditions, and/or postconditions. -- Contains the entity of a wrapper procedure which encapsulates the -- original entry and implements precondition/postcondition semantics. --- Corresponding_Concurrent_Type (Node18) +-- Corresponding_Concurrent_Type -- Defined in record types that are constructed by the expander to -- represent task and protected types (Is_Concurrent_Record_Type flag -- set). Points to the entity for the corresponding task type or the -- protected type. --- Corresponding_Discriminant (Node19) +-- Corresponding_Discriminant -- Defined in discriminants of a derived type, when the discriminant is -- used to constrain a discriminant of the parent type. Points to the -- corresponding discriminant in the parent type. Otherwise it is Empty. --- Corresponding_Equality (Node30) +-- Corresponding_Equality -- Defined in function entities for implicit inequality operators. -- Denotes the explicit or derived equality operation that creates -- the implicit inequality. Note that this field is not present in -- other function entities, only in implicit inequality routines, -- where Comes_From_Source is always False. --- Corresponding_Function (Node32) +-- Corresponding_Function -- Defined on procedures internally built with an extra out parameter -- to return a constrained array type, when Modify_Tree_For_C is set. -- Denotes the function that returns the constrained array type for -- which this procedure was built. --- Corresponding_Procedure (Node32) +-- Corresponding_Procedure -- Defined on functions that return a constrained array type, when -- Modify_Tree_For_C is set. Denotes the internally built procedure -- with an extra out parameter created for it. --- Corresponding_Record_Component (Node21) +-- Corresponding_Record_Component -- Defined in components of a derived untagged record type, including -- discriminants. For a regular component or a girder discriminant, -- points to the corresponding component in the parent type. Set to @@ -748,30 +751,30 @@ package Einfo is -- ensure the layout of the derived type matches that of the parent -- type when there is no representation clause on the derived type. --- Corresponding_Record_Type (Node18) +-- Corresponding_Record_Type -- Defined in protected and task types and subtypes. References the -- entity for the corresponding record type constructed by the expander -- (see Exp_Ch9). This type is used to represent values of the task type. --- Corresponding_Remote_Type (Node22) +-- Corresponding_Remote_Type -- Defined in record types that describe the fat pointer structure for -- Remote_Access_To_Subprogram types. References the original access -- to subprogram type. --- CR_Discriminant (Node23) +-- CR_Discriminant -- Defined in discriminants of concurrent types. Denotes the homologous -- discriminant of the corresponding record type. The CR_Discriminant is -- created at the same time as the discriminal, and used to replace -- occurrences of the discriminant within the type declaration. --- Current_Use_Clause (Node27) +-- Current_Use_Clause -- Defined in packages and in types. For packages, denotes the use -- package clause currently in scope that makes the package use_visible. -- For types, it denotes the use_type clause that makes the operators of -- the type visible. Used for more precise warning messages on redundant -- use clauses. --- Current_Value (Node9) +-- Current_Value -- Defined in all object entities. Set in E_Variable, E_Constant, formal -- parameters and E_Loop_Parameter entities if we have trackable current -- values. Set non-Empty if the (constant) current value of the variable @@ -792,7 +795,7 @@ package Einfo is -- consulted to give information about the value of OBJ. For more details -- on this usage, see the procedure Exp_Util.Get_Current_Value_Condition. --- Debug_Info_Off (Flag166) +-- Debug_Info_Off -- Defined in all entities. Set if a pragma Suppress_Debug_Info applies -- to the entity, or if internal processing in the compiler determines -- that suppression of debug information is desirable. Note that this @@ -800,7 +803,7 @@ package Einfo is -- determining if Needs_Debug_Info should be set. The backend should -- always test Needs_Debug_Info, it should never test Debug_Info_Off. --- Debug_Renaming_Link (Node25) +-- Debug_Renaming_Link -- Used to link the variable associated with a debug renaming declaration -- to the renamed entity. See Exp_Dbug.Debug_Renaming_Declaration for -- details of the use of this field. @@ -816,36 +819,36 @@ package Einfo is -- subprograms, this returns the {function,procedure}_specification, not -- the subprogram_declaration. --- Default_Aspect_Component_Value (Node19) [base type only] +-- Default_Aspect_Component_Value [base type only] -- Defined in array types. Holds the static value specified in a -- Default_Component_Value aspect specification for the array type, -- or inherited on derivation. --- Default_Aspect_Value (Node19) [base type only] +-- Default_Aspect_Value [base type only] -- Defined in scalar types. Holds the static value specified in a -- Default_Value aspect specification for the type, or inherited -- on derivation. --- Default_Expr_Function (Node21) +-- Default_Expr_Function -- Defined in parameters. It holds the entity of the parameterless -- function that is built to evaluate the default expression if it is -- more complex than a simple identifier or literal. For the latter -- simple cases or if there is no default value, this field is Empty. --- Default_Expressions_Processed (Flag108) +-- Default_Expressions_Processed -- A flag in subprograms (functions, operators, procedures) and in -- entries and entry families used to indicate that default expressions -- have been processed and to avoid multiple calls to process the -- default expressions (see Freeze.Process_Default_Expressions), which -- would not only waste time, but also generate false error messages. --- Default_Value (Node20) +-- Default_Value -- Defined in formal parameters. Points to the node representing the -- expression for the default value for the parameter. Empty if the -- parameter has no default value (which is always the case for OUT -- and IN OUT parameters in the absence of errors). --- Delay_Cleanups (Flag114) +-- Delay_Cleanups -- Defined in entities that have finalization lists (subprograms -- blocks, and tasks). Set if there are pending generic body -- instantiations for the corresponding entity. If this flag is @@ -853,7 +856,7 @@ package Einfo is -- entity must be delayed, since the insertion of the generic body -- may affect cleanup generation (see Inline for further details). --- Delay_Subprogram_Descriptors (Flag50) +-- Delay_Subprogram_Descriptors -- Defined in entities for which exception subprogram descriptors -- are generated (subprograms, package declarations and package -- bodies). Defined if there are pending generic body instantiations @@ -870,22 +873,22 @@ package Einfo is -- delayed instantiations (in this case the descriptor refers to the -- enclosing elaboration procedure). --- Delta_Value (Ureal18) +-- Delta_Value -- Defined in fixed and decimal types. Points to a universal real -- that holds value of delta for the type, as given in the declaration -- or as inherited by a subtype or derived type. --- Dependent_Instances (Elist8) +-- Dependent_Instances -- Defined in packages that are instances. Holds list of instances -- of inner generics. Used to place freeze nodes for those instances -- after that of the current one, i.e. after the corresponding generic -- bodies. --- Depends_On_Private (Flag14) +-- Depends_On_Private -- Defined in all type entities. Set if the type is private or if it -- depends on a private type. --- Derived_Type_Link (Node31) +-- Derived_Type_Link -- Defined in all type and subtype entities. Set in a base type if -- a derived type declaration is encountered which derives from -- this base type or one of its subtypes, and there are already @@ -923,11 +926,11 @@ package Einfo is -- Note: the reason this is marked as a synthesized attribute is that the -- way this is stored is as an element of the Subprograms_For_Type field. --- Digits_Value (Uint17) +-- Digits_Value -- Defined in floating point types and subtypes and decimal types and -- subtypes. Contains the Digits value specified in the declaration. --- Direct_Primitive_Operations (Elist10) +-- Direct_Primitive_Operations -- Defined in tagged types and subtypes (including synchronized types), -- in tagged private types and in tagged incomplete types. Element list -- of entities for primitive operations of the tagged type. Not defined @@ -939,7 +942,7 @@ package Einfo is -- synchronized type is not constructed. In that case, such types -- carry this attribute directly. --- Directly_Designated_Type (Node20) +-- Directly_Designated_Type -- Defined in access types. This field points to the type that is -- directly designated by the access type. In the case of an access -- type to an incomplete type, this field references the incomplete @@ -949,12 +952,12 @@ package Einfo is -- Designated_Type obtains this full type in the case of access to an -- incomplete type. --- Disable_Controlled (Flag253) [base type only] +-- Disable_Controlled [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. --- Discard_Names (Flag88) +-- Discard_Names -- Defined in types and exception entities. Set if pragma Discard_Names -- applies to the entity. It is also set for declarative regions and -- package specs for which a Discard_Names pragma with zero arguments @@ -963,24 +966,24 @@ package Einfo is -- after the pragma within the same declarative region. This flag is -- set to False if a Keep_Names pragma appears for an enumeration type. --- Discriminal (Node17) +-- Discriminal -- Defined in discriminants (Discriminant formal: GNAT's first -- coinage). The entity used as a formal parameter that corresponds -- to a discriminant. See section "Handling of Discriminants" for -- full details of the use of discriminals. --- Discriminal_Link (Node10) +-- Discriminal_Link -- Defined in E_In_Parameter or E_Constant entities. For discriminals, -- points back to corresponding discriminant. For other entities, must -- remain Empty. --- Discriminant_Checking_Func (Node20) +-- Discriminant_Checking_Func -- Defined in components. Points to the defining identifier of the -- function built by the expander returns a Boolean indicating whether -- the given record component exists for the current discriminant -- values. --- Discriminant_Constraint (Elist21) +-- Discriminant_Constraint -- Defined in entities whose Has_Discriminants flag is set (concurrent -- types, subtypes, record types and subtypes, private types and -- subtypes, limited private types and subtypes and incomplete types). @@ -1007,24 +1010,24 @@ package Einfo is -- In all other cases Discriminant_Constraint contains the empty -- Elist (i.e. it is initialized with a call to New_Elmt_List). --- Discriminant_Default_Value (Node20) +-- Discriminant_Default_Value -- Defined in discriminants. Points to the node representing the -- expression for the default value of the discriminant. Set to -- Empty if the discriminant has no default value. --- Discriminant_Number (Uint15) +-- Discriminant_Number -- Defined in discriminants. Gives the ranking of a discriminant in -- the list of discriminants of the type, i.e. a sequential integer -- index starting at 1 and ranging up to number of discriminants. --- Dispatch_Table_Wrappers (Elist26) [implementation base type only] +-- Dispatch_Table_Wrappers [implementation base type only] -- Defined in E_Record_Type and E_Record_Subtype entities. Set in library -- level tagged type entities if we are generating statically allocated -- dispatch tables. Points to the list of dispatch table wrappers -- associated with the tagged type. For an untagged record, contains -- No_Elist. --- DTC_Entity (Node16) +-- DTC_Entity -- Defined in function and procedure entities. Set to Empty unless -- the subprogram is dispatching in which case it references the -- Dispatch Table pointer Component. For regular Ada tagged this, this @@ -1033,16 +1036,16 @@ package Einfo is -- Vtable pointer for the Vtable containing the entry referencing the -- subprogram. --- DT_Entry_Count (Uint15) +-- DT_Entry_Count -- Defined in E_Component entities. Only used for component marked -- Is_Tag. Store the number of entries in the Vtable (or Dispatch Table) --- DT_Offset_To_Top_Func (Node25) +-- DT_Offset_To_Top_Func -- Defined in E_Component entities. Only used for component marked -- Is_Tag. If present it stores the Offset_To_Top function used to -- provide this value in tagged types whose ancestor has discriminants. --- DT_Position (Uint15) +-- DT_Position -- Defined in function and procedure entities which are dispatching -- (should not be referenced without first checking that flag -- Is_Dispatching_Operation is True). Contains the offset into @@ -1052,7 +1055,7 @@ package Einfo is -- Defined in all entities. Contains a value of the enumeration type -- Entity_Kind declared in a subsequent section in this spec. --- Elaborate_Body_Desirable (Flag210) +-- Elaborate_Body_Desirable -- Defined in package entities. Set if the elaboration circuitry detects -- a case where there is a package body that modifies one or more visible -- entities in the package spec and there is no explicit Elaborate_Body @@ -1060,7 +1063,7 @@ package Einfo is -- which attempts, but does not promise, to elaborate the body as close -- to the spec as possible. --- Elaboration_Entity (Node13) +-- Elaboration_Entity -- Defined in entry, entry family, [generic] package, and subprogram -- entities. This is a counter associated with the unit that is initially -- set to zero, is incremented when an elaboration request for the unit @@ -1080,7 +1083,7 @@ package Einfo is -- allocated (since we don't know early enough whether or not there -- is elaboration code), but is simply not used for any purpose. --- Elaboration_Entity_Required (Flag174) +-- Elaboration_Entity_Required -- Defined in entry, entry family, [generic] package, and subprogram -- entities. Set only if Elaboration_Entity is non-Empty to indicate that -- the counter is required to be non-zero even if there is no other @@ -1090,30 +1093,30 @@ package Einfo is -- then if there is no other elaboration code, obviously there is no -- need to set the flag. --- Encapsulating_State (Node32) +-- Encapsulating_State -- Defined in abstract state, constant and variable entities. Contains -- the entity of an ancestor state or a single concurrent type whose -- refinement utilizes this item as a constituent. --- Enclosing_Scope (Node18) +-- Enclosing_Scope -- Defined in labels. Denotes the innermost enclosing construct that -- contains the label. Identical to the scope of the label, except for -- labels declared in the body of an accept statement, in which case the -- entry_name is the Enclosing_Scope. Used to validate goto's within -- accept statements. --- Entry_Accepted (Flag152) +-- Entry_Accepted -- Defined in E_Entry and E_Entry_Family entities. Set if there is -- at least one accept for this entry in the task body. Used to -- generate warnings for missing accepts. --- Entry_Bodies_Array (Node19) +-- Entry_Bodies_Array -- Defined in protected types for which Has_Entries is true. -- This is the defining identifier for the array of entry body -- action procedures and barrier functions used by the runtime to -- execute the user code associated with each entry. --- Entry_Cancel_Parameter (Node23) +-- Entry_Cancel_Parameter -- Defined in blocks. This only applies to a block statement for -- which the Is_Asynchronous_Call_Block flag is set. It -- contains the defining identifier of an object that must be @@ -1124,17 +1127,17 @@ package Einfo is -- in the case of protected entry calls. In both cases the objects -- are declared in outer scopes to this block. --- Entry_Component (Node11) +-- Entry_Component -- Defined in formal parameters (in, in out and out parameters). Used -- only for formals of entries. References the corresponding component -- of the entry parameter record for the entry. --- Entry_Formal (Node16) +-- Entry_Formal -- Defined in components of the record built to correspond to entry -- parameters. This field points from the component to the formal. It -- is the back pointer corresponding to Entry_Component. --- Entry_Index_Constant (Node18) +-- Entry_Index_Constant -- Defined in an entry index parameter. This is an identifier that -- eventually becomes the name of a constant representing the index -- of the entry family member whose entry body is being executed. Used @@ -1146,12 +1149,12 @@ package Einfo is -- accept statement for a member of the family, and in the prefix of -- 'COUNT when it applies to a family member. --- Entry_Max_Queue_Lengths_Array (Node35) +-- Entry_Max_Queue_Lengths_Array -- Defined in protected types for which Has_Entries is true. Contains the -- defining identifier for the array of naturals used by the runtime to -- limit the queue size of each entry individually. --- Entry_Parameters_Type (Node15) +-- Entry_Parameters_Type -- Defined in entries. Points to the access-to-record type that is -- constructed by the expander to hold a reference to the parameter -- values. This reference is manipulated (as an address) by the @@ -1160,11 +1163,11 @@ package Einfo is -- for further details). Entry_Parameters_Type is Empty if the entry -- has no parameters. --- Enumeration_Pos (Uint11) +-- Enumeration_Pos -- Defined in enumeration literals. Contains the position number -- corresponding to the value of the enumeration literal. --- Enumeration_Rep (Uint12) +-- Enumeration_Rep -- Defined in enumeration literals. Contains the representation that -- corresponds to the value of the enumeration literal. Note that -- this is normally the same as Enumeration_Pos except in the presence @@ -1172,7 +1175,7 @@ package Einfo is -- position of the literal within the type and Rep will have be the -- value given in the representation clause. --- Enumeration_Rep_Expr (Node22) +-- Enumeration_Rep_Expr -- Defined in enumeration literals. Points to the expression in an -- associated enumeration rep clause that provides the representation -- value for this literal. Empty if no enumeration rep clause for this @@ -1180,7 +1183,7 @@ package Einfo is -- an error situation). This is also used to catch duplicate entries -- for the same literal. --- Enum_Pos_To_Rep (Node23) +-- Enum_Pos_To_Rep -- Defined in enumeration types, but not enumeration subtypes. Set to -- Empty unless the enumeration type has a non-standard representation, -- i.e. at least one literal has a representation value different from @@ -1192,7 +1195,7 @@ package Einfo is -- the representation is contiguous, then Enum_Pos_To_Rep is the entity -- of the index type defined above. --- Equivalent_Type (Node18) +-- Equivalent_Type -- Defined in class wide types and subtypes, access to protected -- subprogram types, and in exception types. For a classwide type, it -- is always Empty. For a class wide subtype, it points to an entity @@ -1206,7 +1209,7 @@ package Einfo is -- protected object. For remote Access_To_Subprogram types, it denotes -- the record that is the fat pointer representation of an RAST. --- Esize (Uint12) +-- Esize -- Defined in all types and subtypes, and also for components, constants, -- and variables, including exceptions where it refers to the static data -- allocated for an exception. Contains the Object_Size of the type or of @@ -1222,7 +1225,7 @@ package Einfo is -- During backend processing, the value is back annotated for all zero -- values, so that after the call to the backend, the value is set. --- Etype (Node5) +-- Etype -- Defined in all entities. Represents the type of the entity, which -- is itself another entity. For a type entity, points to the parent -- type for a derived type, or if the type is not derived, points to @@ -1235,7 +1238,7 @@ package Einfo is -- Note one obscure case: for pragma Default_Storage_Pool (null), the -- Etype of the N_Null node is Empty. --- Extra_Accessibility (Node13) +-- Extra_Accessibility -- Defined in formal parameters in the non-generic case. Normally Empty, -- but if expansion is active, and a parameter is one for which a -- dynamic accessibility check is required, then an extra formal of type @@ -1247,7 +1250,7 @@ package Einfo is -- must be retrieved through the entity designed by this field instead of -- being computed. --- Extra_Accessibility_Of_Result (Node19) +-- Extra_Accessibility_Of_Result -- Defined in (non-generic) Function, Operator, and Subprogram_Type -- entities. Normally Empty, but if expansion is active, and a function -- is one for which "the accessibility level of the result ... determined @@ -1256,7 +1259,7 @@ package Einfo is -- and the Extra_Accessibility_Of_Result field of the function points to -- the entity for this extra formal. --- Extra_Constrained (Node23) +-- Extra_Constrained -- Defined in formal parameters in the non-generic case. Normally Empty, -- but if expansion is active and a parameter is one for which a dynamic -- indication of its constrained status is required, then an extra formal @@ -1268,7 +1271,7 @@ package Einfo is -- must be retrieved through the entity designed by this field instead of -- being computed. --- Extra_Formal (Node15) +-- Extra_Formal -- Defined in formal parameters in the non-generic case. Certain -- parameters require extra implicit information to be passed (e.g. the -- flag indicating if an unconstrained variant record argument is @@ -1283,19 +1286,19 @@ package Einfo is -- in connection with unnesting of subprograms, where the ARECnF formal -- that represents an activation record pointer is an extra formal. --- Extra_Formals (Node28) +-- Extra_Formals -- Applies to subprograms, subprogram types, entries, and entry -- families. Returns first extra formal of the subprogram or entry. -- Returns Empty if there are no extra formals. --- Finalization_Master (Node23) [root type only] +-- Finalization_Master [root type only] -- Defined in access-to-controlled or access-to-class-wide types. The -- field contains the entity of the finalization master which handles -- dynamically allocated controlled objects referenced by the access -- type. Empty for access-to-subprogram types. Empty for access types -- whose designated type does not need finalization actions. --- Finalize_Storage_Only (Flag158) [base type only] +-- Finalize_Storage_Only [base type only] -- Defined in all types. Set on direct controlled types to which a -- valid Finalize_Storage_Only pragma applies. This flag is also set on -- composite types when they have at least one controlled component and @@ -1304,7 +1307,7 @@ package Einfo is -- the Finalize_Storage_Only pragma is required at each level of -- derivation. --- Finalizer (Node28) +-- Finalizer -- Applies to package declarations and bodies. Contains the entity of the -- library-level program which finalizes all package-level controlled -- objects. @@ -1320,7 +1323,7 @@ package Einfo is -- Similar to First_Component, but discriminants are not skipped, so will -- find the first discriminant if discriminants are present. --- First_Entity (Node17) +-- First_Entity -- Defined in all entities which act as scopes to which a list of -- associated entities is attached (blocks, class subtypes and types, -- entries, functions, loops, packages, procedures, protected objects, @@ -1328,7 +1331,7 @@ package Einfo is -- Points to a list of associated entities using the Next_Entity field -- as a chain pointer with Empty marking the end of the list. --- First_Exit_Statement (Node8) +-- First_Exit_Statement -- Defined in E_Loop entity. The exit statements for a loop are chained -- (in reverse order of appearance) using this field to point to the -- first entry in the chain (last exit statement in the loop). The @@ -1348,7 +1351,7 @@ package Einfo is -- Returns Empty if there are no formals. The list returned includes -- all the extra formals (see description of Extra_Formals field). --- First_Index (Node17) +-- First_Index -- Defined in array types and subtypes. By introducing implicit subtypes -- for the index constraints, we have the same structure for constrained -- and unconstrained arrays, subtype marks and discrete ranges are @@ -1358,7 +1361,7 @@ package Einfo is -- this field is defined for the case of string literal subtypes, but is -- always Empty. --- First_Literal (Node17) +-- First_Literal -- Defined in all enumeration types, including character and boolean -- types. This field points to the first enumeration literal entity -- for the type (i.e. it is set to First (Literals (N)) where N is @@ -1368,7 +1371,7 @@ package Einfo is -- Note that this field is set in enumeration subtypes, but it still -- points to the first literal of the base type in this case. --- First_Private_Entity (Node16) +-- First_Private_Entity -- Defined in all entities containing private parts (packages, protected -- types and subtypes, task types and subtypes). The entities on the -- entity chain are in order of declaration, so the entries for private @@ -1376,7 +1379,7 @@ package Einfo is -- entity for the private part. It is Empty if there are no entities -- declared in the private part or if there is no private part. --- First_Rep_Item (Node6) +-- First_Rep_Item -- Defined in all entities. If non-empty, points to a linked list of -- representation pragmas nodes and representation clause nodes that -- apply to the entity, linked using Next_Rep_Item, with Empty marking @@ -1413,25 +1416,25 @@ package Einfo is -- Note in particular that size clauses are defined only for this -- purpose, and should only be accessed if Has_Size_Clause is set. --- Float_Rep (Uint10) [base type only] +-- Float_Rep [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. --- Freeze_Node (Node7) +-- Freeze_Node -- Defined in all entities. If there is an associated freeze node for the -- entity, this field references this freeze node. If no freeze node is -- associated with the entity, then this field is Empty. See package -- Freeze for further details. --- From_Limited_With (Flag159) +-- From_Limited_With -- Defined in abtract states, package and type entities. Set to True when -- the related entity is generated by the expansion of a limited with -- clause. Such an entity is said to be a "shadow" - it acts as the -- abstract view of a state or variable or as the incomplete view of a -- type by inheriting relevant attributes from the said entity. --- Full_View (Node11) +-- Full_View -- Defined in all type and subtype entities and in deferred constants. -- References the entity for the corresponding full type or constant -- declaration. For all types other than private and incomplete types, @@ -1440,29 +1443,29 @@ package Einfo is -- E3 then the full view of E1 is E2, and the full view of E2 is E3. See -- also Underlying_Type. --- Generic_Homonym (Node11) +-- Generic_Homonym -- Defined in generic packages. The generic homonym is the entity of -- a renaming declaration inserted in every generic unit. It is used -- to resolve the name of a local entity that is given by a qualified -- name, when the generic entity itself is hidden by a local name. --- Generic_Renamings (Elist23) +-- Generic_Renamings -- Defined in package and subprogram instances. Holds mapping that -- associates generic parameters with the corresponding instances, in -- those cases where the instance is an entity. --- Handler_Records (List10) +-- Handler_Records -- Defined in subprogram and package entities. Points to a list of -- identifiers referencing the handler record entities for the -- corresponding unit. --- Has_Aliased_Components (Flag135) [implementation base type only] +-- Has_Aliased_Components [implementation base type only] -- Defined in array type entities. Indicates that the component type -- of the array is aliased. Should this also be set for records to -- indicate that at least one component is aliased (see processing in -- Sem_Prag.Process_Atomic_Independent_Shared_Volatile???) --- Has_Alignment_Clause (Flag46) +-- Has_Alignment_Clause -- Defined in all type entities and objects. Indicates if an alignment -- clause has been given for the entity. If set, then Alignment_Clause -- returns the N_Attribute_Definition node for the alignment attribute @@ -1470,13 +1473,13 @@ package Einfo is -- even when Alignment_Clause returns non_Empty (this happens in the case -- of derived type declarations). --- Has_All_Calls_Remote (Flag79) +-- Has_All_Calls_Remote -- Defined in all library unit entities. Set if the library unit has an -- All_Calls_Remote pragma. Note that such entities must also be RCI -- entities, so the flag Is_Remote_Call_Interface will always be set if -- this flag is set. --- Has_Atomic_Components (Flag86) [implementation base type only] +-- Has_Atomic_Components [implementation base type only] -- Defined in all types and objects. Set only for an array type or -- an array object if a valid pragma Atomic_Components applies to the -- type or object. Note that in the case of an object, this flag is @@ -1492,7 +1495,7 @@ package Einfo is -- represent protected types. Returns True if there is at least one -- Attach_Handler pragma in the corresponding specification. --- Has_Biased_Representation (Flag139) +-- Has_Biased_Representation -- Defined in discrete types (where it applies to the type'size value), -- and to objects (both stand-alone and components), where it applies to -- the size of the object from a size or record component clause. In @@ -1508,27 +1511,27 @@ package Einfo is -- size of the type, forcing biased representation for the object, but -- the subtype is still an unbiased type. --- Has_Completion (Flag26) +-- Has_Completion -- Defined in all entities that require a completion (functions, -- procedures, private types, limited private types, incomplete types, -- constants and packages that require a body). The flag is set if the -- completion has been encountered and analyzed. --- Has_Completion_In_Body (Flag71) +-- Has_Completion_In_Body -- Defined in all entities for types and subtypes. Set only in "Taft -- amendment types" (incomplete types whose full declaration appears in -- the package body). --- Has_Complex_Representation (Flag140) [implementation base type only] +-- Has_Complex_Representation [implementation base type only] -- Defined in record types. Set only for a base type to which a valid -- pragma Complex_Representation applies. --- Has_Component_Size_Clause (Flag68) [implementation base type only] +-- Has_Component_Size_Clause [implementation base type only] -- Defined in all type entities. Set if a component size clause is -- Defined for the given type. Note that this flag can be False even -- if Component_Size is non-zero (happens in the case of derived types). --- Has_Constrained_Partial_View (Flag187) [base type only] +-- Has_Constrained_Partial_View [base type only] -- Defined in private type and their completions, when the private -- type has no discriminants and the full view has discriminants with -- defaults. In Ada 2005 heap-allocated objects of such types are not @@ -1540,26 +1543,26 @@ package Einfo is -- partial view. The predicate Object_Type_Has_Constrained_Partial_View -- in sem_aux is used to test for this case. --- Has_Contiguous_Rep (Flag181) +-- Has_Contiguous_Rep -- Defined in enumeration types. Set if the type has a representation -- clause whose entries are successive integers. --- Has_Controlled_Component (Flag43) [base type only] +-- Has_Controlled_Component [base type only] -- Defined in all type and subtype entities. Set only for composite type -- entities which contain a component that either is a controlled type, -- or itself contains controlled component (i.e. either Is_Controlled or -- Has_Controlled_Component is set for at least one component). --- Has_Controlling_Result (Flag98) +-- Has_Controlling_Result -- Defined in E_Function entities. Set if the function is a primitive -- function of a tagged type which can dispatch on result. --- Has_Convention_Pragma (Flag119) +-- Has_Convention_Pragma -- Defined in all entities. Set for an entity for which a valid pragma -- Convention, Import, or Export has been given. Used to prevent more -- than one such pragma appearing for a given entity (RM B.1(45)). --- Has_Default_Aspect (Flag39) [base type only] +-- Has_Default_Aspect [base type only] -- Defined in entities for types and subtypes, set for scalar types with -- a Default_Value aspect and array types with a Default_Component_Value -- aspect. If this flag is set, then a corresponding aspect specification @@ -1568,19 +1571,19 @@ package Einfo is -- value is set, but it may be overridden by an aspect declaration on -- type derivation. --- Has_Delayed_Aspects (Flag200) +-- Has_Delayed_Aspects -- Defined in all entities. Set if the Rep_Item chain for the entity has -- one or more N_Aspect_Definition nodes chained which are not to be -- evaluated till the freeze point. The aspect definition expression -- clause has been preanalyzed to get visibility at the point of use, -- but no other action has been taken. --- Has_Delayed_Freeze (Flag18) +-- Has_Delayed_Freeze -- Defined in all entities. Set to indicate that an explicit freeze -- node must be generated for the entity at its freezing point. See -- separate section ("Delayed Freezing and Elaboration") for details. --- Has_Delayed_Rep_Aspects (Flag261) +-- Has_Delayed_Rep_Aspects -- Defined in all types and subtypes. This flag is set if there is at -- least one aspect for a representation characteristic that has to be -- delayed and is one of the characteristics that may be inherited by @@ -1594,14 +1597,14 @@ package Einfo is -- when the type is subject to pragma Default_Initial_Condition (DIC), or -- when the type inherits a DIC pragma from a parent type. --- Has_Discriminants (Flag5) +-- Has_Discriminants -- Defined in all types and subtypes. For types that are allowed to have -- discriminants (record types and subtypes, task types and subtypes, -- protected types and subtypes, private types, limited private types, -- and incomplete types), indicates if the corresponding type or subtype -- has a known discriminant part. Always false for all other types. --- Has_Dispatch_Table (Flag220) +-- Has_Dispatch_Table -- Defined in E_Record_Types that are tagged. Set to indicate that the -- corresponding dispatch table is already built. This flag is used to -- avoid duplicate construction of library level dispatch tables (because @@ -1609,7 +1612,7 @@ package Einfo is -- of the table); otherwise the code that builds the table is added at -- the end of the list of declarations of the package. --- Has_Dynamic_Predicate_Aspect (Flag258) +-- Has_Dynamic_Predicate_Aspect -- Defined in all types and subtypes. Set if a Dynamic_Predicate aspect -- was explicitly applied to the type. Generally we treat predicates as -- static if possible, regardless of whether they are specified using @@ -1628,17 +1631,17 @@ package Einfo is -- Applies to concurrent types. True if any entries are declared -- within the task or protected definition for the type. --- Has_Enumeration_Rep_Clause (Flag66) +-- Has_Enumeration_Rep_Clause -- Defined in enumeration types. Set if an enumeration representation -- clause has been given for this enumeration type. Used to prevent more -- than one enumeration representation clause for a given type. Note -- that this does not imply a representation with holes, since the rep -- clause may merely confirm the default 0..N representation. --- Has_Exit (Flag47) +-- Has_Exit -- Defined in loop entities. Set if the loop contains an exit statement. --- Has_Expanded_Contract (Flag240) +-- Has_Expanded_Contract -- Defined in functions, procedures, entries, and entry families. Set -- when a subprogram has a N_Contract node that has been expanded. The -- flag prevents double expansion of a contract when a construct is @@ -1650,7 +1653,7 @@ package Einfo is -- Convention_Intrinsic, Convention_Entry, Convention_Protected, -- Convention_Stubbed and Convention_Ada_Pass_By_(Copy,Reference). --- Has_Forward_Instantiation (Flag175) +-- Has_Forward_Instantiation -- Defined in package entities. Set for packages that instantiate local -- generic entities before the corresponding generic body has been seen. -- If a package has a forward instantiation, we cannot inline subprograms @@ -1658,13 +1661,13 @@ package Einfo is -- the instance will conflict with the linear elaboration of front-end -- inlining. --- Has_Fully_Qualified_Name (Flag173) +-- Has_Fully_Qualified_Name -- Defined in all entities. Set if the name in the Chars field has been -- replaced by the fully qualified name, as used for debug output. See -- Exp_Dbug for a full description of the use of this flag and also the -- related flag Has_Qualified_Name. --- Has_Gigi_Rep_Item (Flag82) +-- Has_Gigi_Rep_Item -- Defined in all entities. Set if the rep item chain (referenced by -- First_Rep_Item and linked through the Next_Rep_Item chain) contains a -- representation item that needs to be specially processed by the back @@ -1681,16 +1684,16 @@ package Einfo is -- to process any of these items that appear. At least one such item will -- be present. -- --- Has_Homonym (Flag56) +-- Has_Homonym -- Defined in all entities. Set if an entity has a homonym in the same -- scope. Used by the backend to generate unique names for all entities. --- Has_Implicit_Dereference (Flag251) +-- Has_Implicit_Dereference -- Defined in types and discriminants. Set if the type has an aspect -- Implicit_Dereference. Set also on the discriminant named in the aspect -- clause, to simplify type resolution. --- Has_Independent_Components (Flag34) [implementation base type only] +-- Has_Independent_Components [implementation base type only] -- Defined in all types and objects. Set only for a record type or an -- array type or array object if a valid pragma Independent_Components -- applies to the type or object. Note that in the case of an object, @@ -1702,23 +1705,23 @@ package Einfo is -- usual manner. Also set if a pragma Has_Atomic_Components or pragma -- Has_Aliased_Components applies to the type or object. --- Has_Inheritable_Invariants (Flag248) [base type only] +-- Has_Inheritable_Invariants [base type only] -- Defined in all type entities. Set on private types and interface types -- which define at least one class-wide invariant. Such invariants must -- be inherited by derived types. The flag is also set on the full view -- of a private type for completeness. --- Has_Inherited_DIC (Flag133) [base type only] +-- Has_Inherited_DIC [base type only] -- Defined in all type entities. Set for a derived type which inherits -- pragma Default_Initial_Condition from a parent type. --- Has_Inherited_Invariants (Flag291) [base type only] +-- Has_Inherited_Invariants [base type only] -- Defined in all type entities. Set on private extensions and derived -- types which inherit at least one class-wide invariant from a parent or -- an interface type. The flag is also set on the full view of a private -- extension for completeness. --- Has_Initial_Value (Flag219) +-- Has_Initial_Value -- Defined in entities for variables and out parameters. Set if there -- is an explicit initial value expression in the declaration of the -- variable. Note that this is set only if this initial value is @@ -1741,35 +1744,35 @@ package Einfo is -- Defined in all entities. True for non-generic package entities that -- are non-instances and their Limited_View attribute is present. --- Has_Loop_Entry_Attributes (Flag260) +-- Has_Loop_Entry_Attributes -- Defined in E_Loop entities. Set when the loop is subject to at least -- one attribute 'Loop_Entry. The flag also implies that the loop has -- already been transformed. See Expand_Loop_Entry_Attribute for details. --- Has_Machine_Radix_Clause (Flag83) +-- Has_Machine_Radix_Clause -- Defined in decimal types and subtypes, set if a Machine_Radix -- representation clause is present. This flag is used to detect -- the error of multiple machine radix clauses for a single type. --- Has_Master_Entity (Flag21) +-- Has_Master_Entity -- Defined in entities that can appear in the scope stack (see spec -- of Sem). It is set if a task master entity (_master) has been -- declared and initialized in the corresponding scope. --- Has_Missing_Return (Flag142) +-- Has_Missing_Return -- Defined in functions and generic functions. Set if there is one or -- more missing return statements in the function. This is used to -- control wrapping of the body in Exp_Ch6 to ensure that the program -- error exception is correctly raised in this case at run time. --- Has_Nested_Block_With_Handler (Flag101) +-- Has_Nested_Block_With_Handler -- Defined in scope entities. Set if there is a nested block within the -- scope that has an exception handler and the two scopes are in the -- same procedure. This is used by the backend for controlling certain -- optimizations to ensure that they are consistent with exceptions. -- See documentation in backend for further details. --- Has_Nested_Subprogram (Flag282) +-- Has_Nested_Subprogram -- Defined in subprogram entities. Set for a subprogram which contains at -- least one nested subprogram. @@ -1787,7 +1790,7 @@ package Einfo is -- refinement of at least one variable or state constituent as expressed -- in aspect/pragma Refined_State. --- Has_Non_Standard_Rep (Flag75) [implementation base type only] +-- Has_Non_Standard_Rep [implementation base type only] -- Defined in all type entities. Set when some representation clause -- or pragma causes the representation of the item to be significantly -- modified. In this category are changes of small or radix for a @@ -1805,22 +1808,22 @@ package Einfo is -- Defined in E_Abstract_State entities. True if the state has a visible -- null refinement as expressed in aspect/pragma Refined_State. --- Has_Object_Size_Clause (Flag172) +-- Has_Object_Size_Clause -- Defined in entities for types and subtypes. Set if an Object_Size -- clause has been processed for the type. Used to prevent multiple -- Object_Size clauses for a given entity. --- Has_Out_Or_In_Out_Parameter (Flag110) +-- Has_Out_Or_In_Out_Parameter -- Present in subprograms, generic subprograms, entries, and entry -- families. Set if they have at least one OUT or IN OUT parameter -- (allowed for functions only in Ada 2012). --- Has_Own_DIC (Flag3) [base type only] +-- Has_Own_DIC [base type only] -- Defined in all type entities. Set for a private type and its full view -- (and its underlying full view, if the full view is itself private) -- when the type is subject to pragma Default_Initial_Condition. --- Has_Own_Invariants (Flag232) [base type only] +-- Has_Own_Invariants [base type only] -- Defined in all type entities. Set on any type that defines at least -- one invariant of its own. @@ -1828,7 +1831,7 @@ package Einfo is -- an Invariant pragma or aspect applies, and on the underlying full view -- if the full view is private. --- Has_Partial_Visible_Refinement (Flag296) +-- Has_Partial_Visible_Refinement -- Defined in E_Abstract_State entities. Set when a state has at least -- one refinement constituent subject to indicator Part_Of, and analysis -- is in the region between the declaration of the first constituent for @@ -1836,7 +1839,7 @@ package Einfo is -- of the package spec or body with visibility over this private part -- (which includes the package itself and its child packages). --- Has_Per_Object_Constraint (Flag154) +-- Has_Per_Object_Constraint -- Defined in E_Component entities. Set if the subtype of the component -- has a per object constraint. Per object constraints result from the -- following situations : @@ -1852,15 +1855,15 @@ package Einfo is -- 5. N_Range_Constraint - when the range expression uses the -- discriminant of the enclosing type. --- Has_Pragma_Controlled (Flag27) [implementation base type only] +-- Has_Pragma_Controlled [implementation base type only] -- Defined in access type entities. It is set if a pragma Controlled -- applies to the access type. --- Has_Pragma_Elaborate_Body (Flag150) +-- Has_Pragma_Elaborate_Body -- Defined in all entities. Set in compilation unit entities if a -- pragma Elaborate_Body applies to the compilation unit. --- Has_Pragma_Inline (Flag157) +-- Has_Pragma_Inline -- Defined in all entities. Set for functions and procedures for which a -- pragma Inline or Inline_Always applies to the subprogram. Note that -- this flag can be set even if Is_Inlined is not set. This happens for @@ -1869,55 +1872,55 @@ package Einfo is -- for checking semantic correctness. The flag Is_Inlined indicates -- whether inlining is actually active for the entity. --- Has_Pragma_Inline_Always (Flag230) +-- Has_Pragma_Inline_Always -- Defined in all entities. Set for functions and procedures for which a -- pragma Inline_Always applies. Note that if this flag is set, the flag -- Has_Pragma_Inline is also set. --- Has_Pragma_No_Inline (Flag201) +-- Has_Pragma_No_Inline -- Defined in all entities. Set for functions and procedures for which a -- pragma No_Inline applies. Note that if this flag is set, the flag -- Has_Pragma_Inline_Always cannot be set. --- Has_Pragma_Ordered (Flag198) [implementation base type only] +-- Has_Pragma_Ordered [implementation base type only] -- Defined in entities for enumeration types. If set indicates that a -- valid pragma Ordered was given for the type. This flag is inherited -- by derived enumeration types. We don't need to distinguish the derived -- case since we allow multiple occurrences of this pragma anyway. --- Has_Pragma_Pack (Flag121) [implementation base type only] +-- Has_Pragma_Pack [implementation base type only] -- Defined in array and record type entities. If set, indicates that a -- valid pragma Pack was given for the type. Note that this flag is not -- inherited by derived type. See also the Is_Packed flag. --- Has_Pragma_Preelab_Init (Flag221) +-- Has_Pragma_Preelab_Init -- Defined in type and subtype entities. If set indicates that a valid -- pragma Preelaborable_Initialization applies to the type. --- Has_Pragma_Pure (Flag203) +-- Has_Pragma_Pure -- Defined in all entities. If set, indicates that a valid pragma Pure -- was given for the entity. In some cases, we need to test whether -- Is_Pure was explicitly set using this pragma. --- Has_Pragma_Pure_Function (Flag179) +-- Has_Pragma_Pure_Function -- Defined in all entities. If set, indicates that a valid pragma -- Pure_Function was given for the entity. In some cases, we need to test -- whether Is_Pure was explicitly set using this pragma. We also set -- this flag for some internal entities that we know should be treated -- as pure for optimization purposes. --- Has_Pragma_Thread_Local_Storage (Flag169) +-- Has_Pragma_Thread_Local_Storage -- Defined in all entities. If set, indicates that a valid pragma -- Thread_Local_Storage was given for the entity. --- Has_Pragma_Unmodified (Flag233) +-- Has_Pragma_Unmodified -- Defined in all entities. Can only be set for variables (E_Variable, -- E_Out_Parameter, E_In_Out_Parameter). Set if a valid pragma Unmodified -- applies to the variable, indicating that no warning should be given -- if the entity is never modified. Note that clients should generally -- not test this flag directly, but instead use function Has_Unmodified. --- Has_Pragma_Unreferenced (Flag180) +-- Has_Pragma_Unreferenced -- Defined in all entities. Set if a valid pragma Unreferenced applies -- to the entity, indicating that no warning should be given if the -- entity has no references, but a warning should be given if it is @@ -1928,19 +1931,19 @@ package Einfo is -- ??? this real description was clobbered --- Has_Pragma_Unreferenced_Objects (Flag212) +-- Has_Pragma_Unreferenced_Objects -- Defined in all entities. Set if a valid pragma Unused applies to an -- entity, indicating that warnings should be given if the entity is -- modified or referenced. This pragma is equivalent to a pair of -- Unmodified and Unreferenced pragmas. --- Has_Pragma_Unused (Flag294) +-- Has_Pragma_Unused -- Defined in all entities. Set if a valid pragma Unused applies to a -- variable or entity, indicating that warnings should not be given if -- it is never modified or referenced. Note: This pragma is exactly -- equivalent Unmodified and Unreference combined. --- Has_Predicates (Flag250) +-- Has_Predicates -- Defined in type and subtype entities. Set if a pragma Predicate or -- Predicate aspect applies to the type or subtype, or if it inherits a -- Predicate aspect from its parent or progenitor types. @@ -1949,11 +1952,11 @@ package Einfo is -- a Predicate pragma or aspect applies, and on the underlying full view -- if the full view is private. --- Has_Primitive_Operations (Flag120) [base type only] +-- Has_Primitive_Operations [base type only] -- Defined in all type entities. Set if at least one primitive operation -- is defined for the type. --- Has_Private_Ancestor (Flag151) +-- Has_Private_Ancestor -- Applies to type extensions. True if some ancestor is derived from a -- private type, making some components invisible and aggregates illegal. -- This flag is set at the point of derivation. The legality of the @@ -1961,19 +1964,19 @@ package Einfo is -- at the point the aggregate is resolved. See sem_aggr.adb. This is part -- of AI05-0115. --- Has_Private_Declaration (Flag155) +-- Has_Private_Declaration -- Defined in all entities. Set if it is the defining entity of a private -- type declaration or its corresponding full declaration. This flag is -- thus preserved when the full and the partial views are exchanged, to -- indicate if a full type declaration is a completion. Used for semantic -- checks in E.4(18) and elsewhere. --- Has_Private_Extension (Flag300) +-- Has_Private_Extension -- Defined in tagged types. Set to indicate that the tagged type has some -- private extension. Used to report a warning on public primitives added -- after defining its private extensions. --- Has_Protected (Flag271) [base type only] +-- Has_Protected [base type only] -- Defined in all type entities. Set on protected types themselves, and -- also (recursively) on any composite type which has a component for -- which Has_Protected is set, unless the protected type is declared in @@ -1981,7 +1984,7 @@ package Einfo is -- for protected types apply to this type. Note: the flag is not set on -- access types, even if they designate an object that Has_Protected. --- Has_Qualified_Name (Flag161) +-- Has_Qualified_Name -- Defined in all entities. Set if the name in the Chars field has -- been replaced by its qualified name, as used for debug output. See -- Exp_Dbug for a full description of qualification requirements. For @@ -1991,41 +1994,41 @@ package Einfo is -- flag Has_Fully_Qualified_Name, which is set if the name does indeed -- include the fully qualified name. --- Has_RACW (Flag214) +-- Has_RACW -- Defined in package spec entities. Set if the spec contains the -- declaration of a remote access-to-classwide type. --- Has_Record_Rep_Clause (Flag65) [implementation base type only] +-- Has_Record_Rep_Clause [implementation base type only] -- Defined in record types. Set if a record representation clause has -- been given for this record type. Used to prevent more than one such -- clause for a given record type. Note that this is initially cleared -- for a derived type, even though the representation is inherited. See -- also the flag Has_Specified_Layout. --- Has_Recursive_Call (Flag143) +-- Has_Recursive_Call -- Defined in procedures. Set if a direct parameterless recursive call -- is detected while analyzing the body. Used to activate some error -- checks for infinite recursion. --- Has_Shift_Operator (Flag267) [base type only] +-- Has_Shift_Operator [base type only] -- Defined in integer types. Set in the base type of an integer type for -- which at least one of the shift operators is defined. --- Has_Size_Clause (Flag29) +-- Has_Size_Clause -- Defined in entities for types and objects. Set if a size clause is -- defined for the entity. Used to prevent multiple Size clauses for a -- given entity. Note that it is always initially cleared for a derived -- type, even though the Size for such a type is inherited from a Size -- clause given for the parent type. --- Has_Small_Clause (Flag67) +-- Has_Small_Clause -- Defined in ordinary fixed point types (but not subtypes). Indicates -- that a small clause has been given for the entity. Used to prevent -- multiple Small clauses for a given entity. Note that it is always -- initially cleared for a derived type, even though the Small for such -- a type is inherited from a Small clause given for the parent type. --- Has_Specified_Layout (Flag100) [implementation base type only] +-- Has_Specified_Layout [implementation base type only] -- Defined in all type entities. Set for a record type or subtype if -- the record layout has been specified by a record representation -- clause. Note that this differs from the flag Has_Record_Rep_Clause @@ -2034,23 +2037,23 @@ package Einfo is -- representation clause, and thus is not inherited by a derived type. -- This flag is always False for non-record types. --- Has_Specified_Stream_Input (Flag190) --- Has_Specified_Stream_Output (Flag191) --- Has_Specified_Stream_Read (Flag192) --- Has_Specified_Stream_Write (Flag193) +-- Has_Specified_Stream_Input +-- Has_Specified_Stream_Output +-- Has_Specified_Stream_Read +-- Has_Specified_Stream_Write -- Defined in all type and subtype entities. Set for a given view if the -- corresponding stream-oriented attribute has been defined by an -- attribute definition clause. When such a clause occurs, a TSS is set -- on the underlying full view; the flags are used to track visibility of -- the attribute definition clause for partial or incomplete views. --- Has_Static_Discriminants (Flag211) +-- Has_Static_Discriminants -- Defined in record subtypes constrained by discriminant values. Set if -- all the discriminant values have static values, meaning that in the -- case of a variant record, the component list can be trimmed down to -- include only the components corresponding to these discriminants. --- Has_Static_Predicate (Flag269) +-- Has_Static_Predicate -- Defined in all types and subtypes. Set if the type (which must be a -- scalar type) has a predicate whose expression is predicate-static. -- This can result from the use of any Predicate, Static_Predicate, or @@ -2059,7 +2062,7 @@ package Einfo is -- description of the latter flag for further information on dynamic -- predicates which are also static. --- Has_Static_Predicate_Aspect (Flag259) +-- Has_Static_Predicate_Aspect -- Defined in all types and subtypes. Set if a Static_Predicate aspect -- applies to the type. Note that we can tell if a static predicate is -- present by looking at Has_Static_Predicate, but this could have come @@ -2068,7 +2071,7 @@ package Einfo is -- check policies apply, use this flag and Has_Dynamic_Predicate_Aspect -- to determine which case we have). --- Has_Storage_Size_Clause (Flag23) [implementation base type only] +-- Has_Storage_Size_Clause [implementation base type only] -- Defined in task types and access types. It is set if a Storage_Size -- clause is present for the type. Used to prevent multiple clauses for -- one type. Note that this flag is initially cleared for a derived type @@ -2077,30 +2080,30 @@ package Einfo is -- of access types, this flag is defined only in the root type, since a -- storage size clause cannot be given to a derived type. --- Has_Stream_Size_Clause (Flag184) +-- Has_Stream_Size_Clause -- Defined in all entities. It is set for types which have a Stream_Size -- clause attribute. Used to prevent multiple Stream_Size clauses for a -- given entity, and also whether it is necessary to check for a stream -- size clause. --- Has_Task (Flag30) [base type only] +-- Has_Task [base type only] -- Defined in all type entities. Set on task types themselves, and also -- (recursively) on any composite type which has a component for which -- Has_Task is set. The meaning is that an allocator or declaration of -- such an object must create the required tasks. Note: the flag is not -- set on access types, even if they designate an object that Has_Task. --- Has_Timing_Event (Flag289) [base type only] +-- Has_Timing_Event [base type only] -- Defined in all type entities. Set on language defined type -- Ada.Real_Time.Timing_Events.Timing_Event, and also (recursively) on -- any composite type which has a component for which Has_Timing_Event -- is set. Used for the No_Local_Timing_Event restriction. --- Has_Thunks (Flag228) +-- Has_Thunks -- Applies to E_Constant entities marked Is_Tag. True for secondary tag -- referencing a dispatch table whose contents are pointers to thunks. --- Has_Unchecked_Union (Flag123) [base type only] +-- Has_Unchecked_Union [base type only] -- Defined in all type entities. Set on unchecked unions themselves -- and (recursively) on any composite type which has a component for -- which Has_Unchecked_Union is set. The meaning is that a comparison @@ -2108,7 +2111,7 @@ package Einfo is -- Note that the flag is not set on access types, even if they designate -- an object that has the flag Has_Unchecked_Union set. --- Has_Unknown_Discriminants (Flag72) +-- Has_Unknown_Discriminants -- Defined in all entities. Set for types with unknown discriminants. -- Types can have unknown discriminants either from their declaration or -- through type derivation. The use of this flag exactly meets the spec @@ -2121,12 +2124,12 @@ package Einfo is -- on the partial view, to ensure that discriminants are properly -- inherited in certain contexts. --- Has_Visible_Refinement (Flag263) +-- Has_Visible_Refinement -- Defined in E_Abstract_State entities. Set when a state has at least -- one refinement constituent and analysis is in the region between -- pragma Refined_State and the end of the package body declarations. --- Has_Volatile_Components (Flag87) [implementation base type only] +-- Has_Volatile_Components [implementation base type only] -- Defined in all types and objects. Set only for an array type or array -- object if a valid pragma Volatile_Components or a valid pragma -- Atomic_Components applies to the type or object. Note that in the case @@ -2137,7 +2140,7 @@ package Einfo is -- type the pragma will be chained to the rep item chain of the first -- subtype in the usual manner. --- Has_Xref_Entry (Flag182) +-- Has_Xref_Entry -- Defined in all entities. Set if an entity has an entry in the Xref -- information generated in ali files. This is true for all source -- entities in the extended main source file. It is also true of entities @@ -2146,11 +2149,11 @@ package Einfo is -- references an entity with a type reference. See package Lib.Xref for -- further details). --- Has_Yield_Aspect (Flag308) +-- Has_Yield_Aspect -- Defined in subprograms, generic subprograms, entries, entry families. -- Set if the entity has aspect Yield. --- Hiding_Loop_Variable (Node8) +-- Hiding_Loop_Variable -- Defined in variables. Set only if a variable of a discrete type is -- hidden by a loop variable in the same local scope, in which case -- the Hiding_Loop_Variable field of the hidden variable points to @@ -2158,7 +2161,7 @@ package Einfo is -- warning messages if the hidden variable turns out to be unused -- or is referenced without being set. --- Hidden_In_Formal_Instance (Elist30) +-- Hidden_In_Formal_Instance -- Defined on actuals for formal packages. Entities on the list are -- formals that are hidden outside of the formal package when this -- package is not declared with a box, or the formal itself is not @@ -2166,13 +2169,13 @@ package Einfo is -- from the current generic, because the actual for the formal package -- may be used subsequently in the current unit. --- Homonym (Node4) +-- Homonym -- Defined in all entities. Link for list of entities that have the -- same source name and that are declared in the same or enclosing -- scopes. Homonyms in the same scope are overloaded. Used for name -- resolution and for the generation of debugging information. --- Ignore_SPARK_Mode_Pragmas (Flag301) +-- Ignore_SPARK_Mode_Pragmas -- Present in concurrent type, entry, operator, [generic] package, -- package body, [generic] subprogram, and subprogram body entities. -- Set when the entity appears in an instance subject to SPARK_Mode @@ -2186,52 +2189,52 @@ package Einfo is -- that we still have a concrete type. For entities other than types, -- returns the entity unchanged. --- Import_Pragma (Node35) +-- Import_Pragma -- Defined in subprogram entities. Set if a valid pragma Import or pragma -- Import_Function or pragma Import_Procedure applies to the subprogram, -- in which case this field points to the pragma (we can't use the normal -- Rep_Item chain mechanism, because a single pragma Import can apply -- to multiple subprogram entities). --- In_Package_Body (Flag48) +-- In_Package_Body -- Defined in package entities. Set on the entity that denotes the -- package (the defining occurrence of the package declaration) while -- analyzing and expanding the package body. Reset on completion of -- analysis/expansion. --- In_Private_Part (Flag45) +-- In_Private_Part -- Defined in all entities. Can be set only in package entities and -- objects. For package entities, this flag is set to indicate that the -- private part of the package is being analyzed. The flag is reset at -- the end of the package declaration. For objects it indicates that the -- declaration of the object occurs in the private part of a package. --- Incomplete_Actuals (Elist24) +-- Incomplete_Actuals -- Defined on package entities that are instances. Indicates the actuals -- types in the instantiation that are limited views. If this list is -- not empty, the instantiation, which appears in a package declaration, -- is relocated to the corresponding package body, which must have a -- corresponding nonlimited with_clause. --- Initialization_Statements (Node28) +-- Initialization_Statements -- Defined in constants and variables. For a composite object initialized -- with an aggregate that has been converted to a sequence of -- assignments, points to a compound statement containing the -- assignments. --- Inner_Instances (Elist23) +-- Inner_Instances -- Defined in generic units. Contains element list of units that are -- instantiated within the given generic. Used to diagnose circular -- instantiations. --- Interface_Alias (Node25) +-- Interface_Alias -- Defined in subprograms that cover a primitive operation of an abstract -- interface type. Can be set only if the Is_Hidden flag is also set, -- since such entities are always hidden. Points to its associated -- interface subprogram. It is used to register the subprogram in -- secondary dispatch table of the interface (Ada 2005: AI-251). --- Interface_Name (Node21) +-- Interface_Name -- Defined in constants, variables, exceptions, functions, procedures, -- and packages. Set to Empty unless an export, import, or interface name -- pragma has explicitly specified an external name, in which case it @@ -2242,7 +2245,7 @@ package Einfo is -- Interface_Name is ignored if an address clause is present (since it -- is meaningless in this case). --- Interfaces (Elist25) +-- Interfaces -- Defined in record types and subtypes. List of abstract interfaces -- implemented by a tagged type that are not already implemented by the -- ancestors (Ada 2005: AI-251). @@ -2263,21 +2266,21 @@ package Einfo is -- Note: the reason this is marked as a synthesized attribute is that the -- way this is stored is as an element of the Subprograms_For_Type field. --- In_Use (Flag8) +-- In_Use -- Defined in packages and types. Set when analyzing a use clause for -- the corresponding entity. Reset at end of corresponding declarative -- part. The flag on a type is also used to determine the visibility of -- the primitive operators of the type. --- Is_Abstract_Subprogram (Flag19) +-- Is_Abstract_Subprogram -- Defined in all subprograms and entries. Set for abstract subprograms. -- Always False for enumeration literals and entries. See also -- Requires_Overriding. --- Is_Abstract_Type (Flag146) +-- Is_Abstract_Type -- Defined in all types. Set for abstract types. --- Is_Access_Constant (Flag69) +-- Is_Access_Constant -- Defined in access types and subtypes. Indicates that the keyword -- constant was present in the access type definition. @@ -2291,30 +2294,30 @@ package Einfo is -- Is_Access_Object_Type (synthesized) -- Applies to all entities, true for access-to-object types and subtypes --- Is_Activation_Record (Flag305) +-- Is_Activation_Record -- Applies to E_In_Parameters generated in Exp_Unst for nested -- subprograms, to mark the added formal that carries the activation -- record created in the enclosing subprogram. --- Is_Actual_Subtype (Flag293) +-- Is_Actual_Subtype -- Defined on all types, true for the generated constrained subtypes -- that are built for unconstrained composite actuals. --- Is_Ada_2005_Only (Flag185) +-- Is_Ada_2005_Only -- Defined in all entities, true if a valid pragma Ada_05 or Ada_2005 -- applies to the entity which specifically names the entity, indicating -- that the entity is Ada 2005 only. Note that this flag is not set if -- the entity is part of a unit compiled with the normal no-argument form -- of pragma Ada_05 or Ada_2005. --- Is_Ada_2012_Only (Flag199) +-- Is_Ada_2012_Only -- Defined in all entities, true if a valid pragma Ada_12 or Ada_2012 -- applies to the entity which specifically names the entity, indicating -- that the entity is Ada 2012 only. Note that this flag is not set if -- the entity is part of a unit compiled with the normal no-argument form -- of pragma Ada_12 or Ada_2012. --- Is_Aliased (Flag15) +-- Is_Aliased -- Defined in all entities. Set for objects and types whose declarations -- carry the keyword aliased, and on record components that have the -- keyword. For Ada 2012, also applies to formal parameters. @@ -2322,11 +2325,11 @@ package Einfo is -- Is_Array_Type (synthesized) -- Applies to all entities, true for array types and subtypes --- Is_Asynchronous (Flag81) +-- Is_Asynchronous -- Defined in all type entities and in procedure entities. Set -- if a pragma Asynchronous applies to the entity. --- Is_Atomic (Flag85) +-- Is_Atomic -- Defined in all type entities, and also in constants, components, and -- variables. Set if a pragma Atomic or Shared applies to the entity. -- In the case of private and incomplete types, this flag is set in @@ -2342,7 +2345,7 @@ package Einfo is -- Is_Base_Type (synthesized) -- Applies to type and subtype entities. True if entity is a base type. --- Is_Bit_Packed_Array (Flag122) [implementation base type only] +-- Is_Bit_Packed_Array [implementation base type only] -- Defined in all entities. This flag is set for a packed array type that -- is bit-packed (i.e. the component size is known by the front end and -- is in the range 1-63 but not a multiple of 8). Is_Packed is always set @@ -2355,33 +2358,33 @@ package Einfo is -- Applies to all entities, true for boolean types and subtypes, -- i.e. Standard.Boolean and all types ultimately derived from it. --- Is_Called (Flag102) +-- Is_Called -- Defined in subprograms and packages. Set if a subprogram is called -- from the unit being compiled or a unit in the closure. Also set for -- a package that contains called subprograms. Used only for inlining. --- Is_Character_Type (Flag63) +-- Is_Character_Type -- Defined in all entities. Set for character types and subtypes, -- i.e. enumeration types that have at least one character literal. --- Is_Checked_Ghost_Entity (Flag277) +-- Is_Checked_Ghost_Entity -- Applies to all entities. Set for abstract states, [generic] packages, -- [generic] subprograms, components, discriminants, formal parameters, -- objects, package bodies, subprogram bodies, and [sub]types subject to -- pragma Ghost or inherit "ghostness" from an enclosing construct, and -- subject to Assertion_Policy Ghost => Check. --- Is_Child_Unit (Flag73) +-- Is_Child_Unit -- Defined in all entities. Set only for defining entities of program -- units that are child units (but False for subunits). --- Is_Class_Wide_Clone (Flag290) +-- Is_Class_Wide_Clone -- Defined on subprogram entities. Set for subprograms built in order -- to implement properly the inheritance of class-wide pre- or post- -- conditions when the condition contains calls to other primitives -- of the ancestor type. Used to implement AI12-0195. --- Is_Class_Wide_Equivalent_Type (Flag35) +-- Is_Class_Wide_Equivalent_Type -- Defined in record types and subtypes. Set to True, if the type acts -- as a class-wide equivalent type, i.e. the Equivalent_Type field of -- some class-wide subtype entity references this record type. @@ -2389,13 +2392,13 @@ package Einfo is -- Is_Class_Wide_Type (synthesized) -- Applies to all entities, true for class wide types and subtypes --- Is_Compilation_Unit (Flag149) +-- Is_Compilation_Unit -- Defined in all entities. Set if the entity is a package or subprogram -- entity for a compilation unit other than a subunit (since we treat -- subunits as part of the same compilation operation as the ultimate -- parent, we do not consider them to be separate units for this flag). --- Is_Completely_Hidden (Flag103) +-- Is_Completely_Hidden -- Defined on discriminants. Only set on girder discriminants of -- untagged types. When set, the entity is a girder discriminant of a -- derived untagged type which is not directly visible in the derived @@ -2408,7 +2411,7 @@ package Einfo is -- Either Is_Composite_Type or Is_Elementary_Type (but not both) is true -- of any type. --- Is_Concurrent_Record_Type (Flag20) +-- Is_Concurrent_Record_Type -- Defined in record types and subtypes. Set if the type was created -- by the expander to represent a task or protected type. For every -- concurrent type, such as record type is constructed, and task and @@ -2425,28 +2428,28 @@ package Einfo is -- Applies to all entities, true for E_Constant, E_Loop_Parameter, and -- E_In_Parameter entities. --- Is_Constrained (Flag12) +-- Is_Constrained -- Defined in types or subtypes which may have index, discriminant -- or range constraint (i.e. array types and subtypes, record types -- and subtypes, string types and subtypes, and all numeric types). -- Set if the type or subtype is constrained. --- Is_Constr_Subt_For_U_Nominal (Flag80) +-- Is_Constr_Subt_For_U_Nominal -- Defined in all types and subtypes. Set only for the constructed -- subtype of an object whose nominal subtype is unconstrained. Note -- that the constructed subtype itself will be constrained. --- Is_Constr_Subt_For_UN_Aliased (Flag141) +-- Is_Constr_Subt_For_UN_Aliased -- Defined in all types and subtypes. This flag can be set only if -- Is_Constr_Subt_For_U_Nominal is also set. It indicates that in -- addition the object concerned is aliased. This flag is used by -- the backend to determine whether a template must be constructed. --- Is_Constructor (Flag76) +-- Is_Constructor -- Defined in function and procedure entities. Set if a pragma -- CPP_Constructor applies to the subprogram. --- Is_Controlled_Active (Flag42) [base type only] +-- Is_Controlled_Active [base type only] -- Defined in all type entities. Indicates that the type is controlled, -- i.e. is either a descendant of Ada.Finalization.Controlled or of -- Ada.Finalization.Limited_Controlled. @@ -2455,15 +2458,15 @@ package Einfo is -- Defined in all type entities. Set if Is_Controlled_Active is set for -- the type, and Disable_Controlled is not set. --- Is_Controlling_Formal (Flag97) +-- Is_Controlling_Formal -- Defined in all Formal_Kind entities. Marks the controlling parameters -- of dispatching operations. --- Is_CPP_Class (Flag74) +-- Is_CPP_Class -- Defined in all type entities, set only for tagged types to which a -- valid pragma Import (CPP, ...) or pragma CPP_Class has been applied. --- Is_CUDA_Kernel (Flag118) +-- Is_CUDA_Kernel -- Defined in function and procedure entities. Set if the subprogram is a -- CUDA kernel. @@ -2471,11 +2474,11 @@ package Einfo is -- Applies to all type entities, true for decimal fixed point -- types and subtypes. --- Is_Descendant_Of_Address (Flag223) +-- Is_Descendant_Of_Address -- Defined in all entities. True if the entity is type System.Address, -- or (recursively) a subtype or derived type of System.Address. --- Is_DIC_Procedure (Flag132) +-- Is_DIC_Procedure -- Defined in functions and procedures. Set for a generated procedure -- which verifies the assumption of pragma Default_Initial_Condition at -- run time. @@ -2487,11 +2490,11 @@ package Einfo is -- Is_Discrete_Type (synthesized) -- Applies to all entities, true for all discrete types and subtypes --- Is_Discrim_SO_Function (Flag176) +-- Is_Discrim_SO_Function -- Defined in all entities. Set only in E_Function entities that Layout -- creates to compute discriminant-dependent dynamic size/offset values. --- Is_Discriminant_Check_Function (Flag264) +-- Is_Discriminant_Check_Function -- Defined in all entities. Set only in E_Function entities for functions -- created to do discriminant checks. @@ -2499,11 +2502,11 @@ package Einfo is -- Applies to all entities, true for renamings of discriminants. Such -- entities appear as constants or IN parameters. --- Is_Dispatch_Table_Entity (Flag234) +-- Is_Dispatch_Table_Entity -- Applies to all entities. Set to indicate to the backend that this -- entity is associated with a dispatch table. --- Is_Dispatching_Operation (Flag6) +-- Is_Dispatching_Operation -- Defined in all entities. Set for procedures, functions, generic -- procedures, and generic functions if the corresponding operation -- is dispatching. @@ -2513,7 +2516,7 @@ package Einfo is -- scope (i.e. a block, subprogram, task_type, entry or extended return -- statement). --- Is_Elaboration_Checks_OK_Id (Flag148) +-- Is_Elaboration_Checks_OK_Id -- Defined in elaboration targets (see terminology in Sem_Elab). Set when -- the target appears in a region which is subject to elabled elaboration -- checks. Such targets are allowed to generate run-time conditional ABE @@ -2523,7 +2526,7 @@ package Einfo is -- Applies to all entities, True only for elaboration targets (see the -- terminology in Sem_Elab). --- Is_Elaboration_Warnings_OK_Id (Flag304) +-- Is_Elaboration_Warnings_OK_Id -- Defined in elaboration targets (see terminology in Sem_Elab). Set when -- the target appears in a region with elaboration warnings enabled. @@ -2532,7 +2535,7 @@ package Einfo is -- Either Is_Composite_Type or Is_Elementary_Type (but not both) is true -- of any type. --- Is_Eliminated (Flag124) +-- Is_Eliminated -- Defined in type entities, subprogram entities, and object entities. -- Indicates that the corresponding entity has been eliminated by use -- of pragma Eliminate. Also used to mark subprogram entities whose @@ -2542,23 +2545,23 @@ package Einfo is -- Applies to all entities, True only for entry and entry family -- entities and False for all other entity kinds. --- Is_Entry_Formal (Flag52) +-- Is_Entry_Formal -- Defined in all entities. Set only for entry formals (which can only -- be in, in-out or out parameters). This flag is used to speed up the -- test for the need to replace references in Exp_Ch2. --- Is_Entry_Wrapper (Flag297) +-- Is_Entry_Wrapper -- Defined on wrappers created for entries that have precondition aspects -- Is_Enumeration_Type (synthesized) -- Defined in all entities, true for enumeration types and subtypes --- Is_Exception_Handler (Flag286) +-- Is_Exception_Handler -- Defined in blocks. Set if the block serves only as a scope of an -- exception handler with a choice parameter. Such a block does not -- physically appear in the tree. --- Is_Exported (Flag99) +-- Is_Exported -- Defined in all entities. Set if the entity is exported. For now we -- only allow the export of constants, exceptions, functions, procedures -- and variables, but that may well change later on. Exceptions can only @@ -2568,7 +2571,7 @@ package Einfo is -- Applies to all entities, true for abstract states that are subject to -- option External or Synchronous. --- Is_Finalized_Transient (Flag252) +-- Is_Finalized_Transient -- Defined in constants, loop parameters of generalized iterators, and -- variables. Set when a transient object has been finalized by one of -- the transient finalization mechanisms. The flag prevents the double @@ -2578,7 +2581,7 @@ package Einfo is -- Applies to all entities, true for procedures containing finalization -- code to process local or library level objects. --- Is_First_Subtype (Flag70) +-- Is_First_Subtype -- Defined in all entities. True for first subtypes (RM 3.2.1(6)), -- i.e. the entity in the type declaration that introduced the type. -- This may be the base type itself (e.g. for record declarations and @@ -2599,21 +2602,21 @@ package Einfo is -- Is_Formal_Object (synthesized) -- Applies to all entities, true for generic IN and IN OUT parameters --- Is_Formal_Subprogram (Flag111) +-- Is_Formal_Subprogram -- Defined in all entities. Set for generic formal subprograms. --- Is_Frozen (Flag4) +-- Is_Frozen -- Defined in all type and subtype entities. Set if type or subtype has -- been frozen. --- Is_Generic_Actual_Subprogram (Flag274) +-- Is_Generic_Actual_Subprogram -- Defined on functions and procedures. Set on the entity of the renaming -- declaration created within an instance for an actual subprogram. -- Used to generate constraint checks on calls to these subprograms, even -- within an instance of a predefined run-time unit, in which checks -- are otherwise suppressed. --- Is_Generic_Actual_Type (Flag94) +-- Is_Generic_Actual_Type -- Defined in all type and subtype entities. Set in the subtype -- declaration that renames the generic formal as a subtype of the -- actual. Guarantees that the subtype is not static within the instance. @@ -2621,7 +2624,7 @@ package Einfo is -- accidental overloading that occurs when different formal types get the -- same actual. --- Is_Generic_Instance (Flag130) +-- Is_Generic_Instance -- Defined in all entities. Set to indicate that the entity is an -- instance of a generic unit, or a formal package (which is an instance -- of the template). @@ -2630,7 +2633,7 @@ package Einfo is -- Applies to all entities. Yields True for a generic subprogram -- (generic function, generic subprogram), False for all other entities. --- Is_Generic_Type (Flag13) +-- Is_Generic_Type -- Defined in all entities. Set for types which are generic formal types. -- Such types have an Ekind that corresponds to their classification, so -- the Ekind cannot be used to identify generic formal types. @@ -2647,7 +2650,7 @@ package Einfo is -- subject to pragma Ghost or those that inherit the Ghost property from -- an enclosing construct. --- Is_Hidden (Flag57) +-- Is_Hidden -- Defined in all entities. Set for all entities declared in the -- private part or body of a package. Also marks generic formals of a -- formal package declared without a box. For library level entities, @@ -2657,42 +2660,42 @@ package Einfo is -- child unit, and when compiling a private child unit (see Install_ -- Private_Declaration in sem_ch7). --- Is_Hidden_Non_Overridden_Subpgm (Flag2) +-- Is_Hidden_Non_Overridden_Subpgm -- Defined in all entities. Set for implicitly declared subprograms -- that require overriding or are null procedures, and are hidden by -- a non-fully conformant homograph with the same characteristics -- (Ada RM 8.3 12.3/2). --- Is_Hidden_Open_Scope (Flag171) +-- Is_Hidden_Open_Scope -- Defined in all entities. Set for a scope that contains the -- instantiation of a child unit, and whose entities are not visible -- during analysis of the instance. --- Is_Ignored_Ghost_Entity (Flag278) +-- Is_Ignored_Ghost_Entity -- Applies to all entities. Set for abstract states, [generic] packages, -- [generic] subprograms, components, discriminants, formal parameters, -- objects, package bodies, subprogram bodies, and [sub]types subject to -- pragma Ghost or inherit "ghostness" from an enclosing construct, and -- subject to Assertion_Policy Ghost => Ignore. --- Is_Ignored_Transient (Flag295) +-- Is_Ignored_Transient -- Defined in constants, loop parameters of generalized iterators, and -- variables. Set when a transient object must be processed by one of -- the transient finalization mechanisms. Once marked, a transient is -- intentionally ignored by the general finalization mechanism because -- its clean up actions are context specific. --- Is_Immediately_Visible (Flag7) +-- Is_Immediately_Visible -- Defined in all entities. Set if entity is immediately visible, i.e. -- is defined in some currently open scope (RM 8.3(4)). --- Is_Implementation_Defined (Flag254) +-- Is_Implementation_Defined -- Defined in all entities. Set if a pragma Implementation_Defined is -- applied to the pragma. Used to mark all implementation defined -- identifiers in standard library packages, and to implement the -- restriction No_Implementation_Identifiers. --- Is_Imported (Flag24) +-- Is_Imported -- Defined in all entities. Set if the entity is imported. For now we -- only allow the import of exceptions, functions, procedures, packages, -- constants, and variables. Exceptions, packages, and types can only be @@ -2704,7 +2707,7 @@ package Einfo is -- Is_Incomplete_Type (synthesized) -- Applies to all entities, true for incomplete types and subtypes --- Is_Independent (Flag268) +-- Is_Independent -- Defined in all types and objects. Set if a valid pragma or aspect -- Independent applies to the entity, or for a component if a valid -- pragma or aspect Independent_Components applies to the enclosing @@ -2714,11 +2717,11 @@ package Einfo is -- case of private and incomplete types, this flag is set in both the -- partial view and the full view. --- Is_Initial_Condition_Procedure (Flag302) +-- Is_Initial_Condition_Procedure -- Defined in functions and procedures. Set for a generated procedure -- which verifies the assumption of pragma Initial_Condition at run time. --- Is_Inlined (Flag11) +-- Is_Inlined -- Defined in all entities. Set for functions and procedures which are -- to be inlined. For subprograms created during expansion, this flag -- may be set directly by the expander to request inlining. Also set @@ -2727,13 +2730,13 @@ package Einfo is -- inherited by their instances. It is also set on the body entities -- of inlined subprograms. See also Has_Pragma_Inline. --- Is_Inlined_Always (Flag1) +-- Is_Inlined_Always -- Defined in subprograms. Set for functions and procedures which are -- always inlined in GNATprove mode. GNATprove uses this flag to know -- when a body does not need to be analyzed. The value of this flag is -- only meaningful if Body_To_Inline is not Empty for the subprogram. --- Is_Instantiated (Flag126) +-- Is_Instantiated -- Defined in generic packages and generic subprograms. Set if the unit -- is instantiated from somewhere in the extended main source unit. This -- flag is used to control warnings about the unit being uninstantiated. @@ -2744,7 +2747,7 @@ package Einfo is -- Is_Integer_Type (synthesized) -- Applies to all entities, true for integer types and subtypes --- Is_Interface (Flag186) +-- Is_Interface -- Defined in record types and subtypes. Set to indicate that the current -- entity corresponds to an abstract interface. Because abstract -- interfaces are conceptually a special kind of abstract tagged type @@ -2753,7 +2756,7 @@ package Einfo is -- compiler support for abstract tagged types to implement interfaces -- (Ada 2005: AI-251). --- Is_Internal (Flag17) +-- Is_Internal -- Defined in all entities. Set to indicate an entity created during -- semantic processing (e.g. an implicit type, or a temporary). The -- current uses of this flag are: @@ -2777,12 +2780,12 @@ package Einfo is -- are used to handle secondary dispatch tables. These entities have -- also the attribute Interface_Alias. --- Is_Interrupt_Handler (Flag89) +-- Is_Interrupt_Handler -- Defined in procedures. Set if a pragma Interrupt_Handler applies -- to the procedure. The procedure must be parameterless, and on all -- targets except AAMP it must be a protected procedure. --- Is_Intrinsic_Subprogram (Flag64) +-- Is_Intrinsic_Subprogram -- Defined in functions and procedures. It is set if a valid pragma -- Interface or Import is present for this subprogram specifying -- convention Intrinsic. Valid means that the name and profile of the @@ -2793,13 +2796,13 @@ package Einfo is -- convention set to intrinsic, which causes intrinsic code to be -- generated. --- Is_Invariant_Procedure (Flag257) +-- Is_Invariant_Procedure -- Defined in functions and procedures. Set for a generated invariant -- procedure which verifies the invariants of both the partial and full -- views of a private type or private extension as well as any inherited -- class-wide invariants from parent types or interfaces. --- Is_Itype (Flag91) +-- Is_Itype -- Defined in all entities. Set to indicate that a type is an Itype, -- which means that the declaration for the type does not appear -- explicitly in the tree. Instead the backend will elaborate the type @@ -2809,7 +2812,7 @@ package Einfo is -- on Itypes is that the first use of such a type (the one that causes it -- to be defined) must be in the same scope as the type. --- Is_Known_Non_Null (Flag37) +-- Is_Known_Non_Null -- Defined in all entities. Relevant (and can be set) only for -- objects of an access type. It is set if the object is currently -- known to have a non-null value (meaning that no access checks @@ -2830,7 +2833,7 @@ package Einfo is -- fully constructed, since it simply indicates the last state. -- Thus this flag has no meaning to the backend. --- Is_Known_Null (Flag204) +-- Is_Known_Null -- Defined in all entities. Relevant (and can be set ) only for -- objects of an access type. It is set if the object is currently known -- to have a null value (meaning that a dereference will surely raise @@ -2840,7 +2843,7 @@ package Einfo is -- The comments above about sequential flow and aliased and volatile for -- the Is_Known_Non_Null flag apply equally to the Is_Known_Null flag. --- Is_Known_Valid (Flag170) +-- Is_Known_Valid -- Defined in all entities. Relevant for types (and subtype) and -- for objects (and enumeration literals) of a discrete type. -- @@ -2874,24 +2877,24 @@ package Einfo is -- fully constructed, since it simply indicates the last state. -- Thus this flag has no meaning to the backend. --- Is_Limited_Composite (Flag106) +-- Is_Limited_Composite -- Defined in all entities. Set for composite types that have a limited -- component. Used to enforce the rule that operations on the composite -- type that depend on the full view of the component do not become -- visible until the immediate scope of the composite type itself -- (RM 7.3.1 (5)). --- Is_Limited_Interface (Flag197) +-- Is_Limited_Interface -- Defined in record types and subtypes. True for interface types, if -- interface is declared limited, task, protected, or synchronized, or -- is derived from a limited interface. --- Is_Limited_Record (Flag25) +-- Is_Limited_Record -- Defined in all entities. Set to true for record (sub)types if the -- record is declared to be limited. Note that this flag is not set -- simply because some components of the record are limited. --- Is_Local_Anonymous_Access (Flag194) +-- Is_Local_Anonymous_Access -- Defined in access types. Set for an anonymous access type to indicate -- that the type is created for a record component with an access -- definition, an array component, or (pre-Ada 2012) a standalone object. @@ -2900,13 +2903,13 @@ package Einfo is -- that are created for access parameters, access discriminants, and -- (as of Ada 2012) stand-alone objects. --- Is_Loop_Parameter (Flag307) +-- Is_Loop_Parameter -- Applies to all entities. Certain loops, in particular "for ... of" -- loops, get transformed so that the loop parameter is declared by a -- variable declaration, so the entity is an E_Variable. This is True for -- such E_Variables; False otherwise. --- Is_Machine_Code_Subprogram (Flag137) +-- Is_Machine_Code_Subprogram -- Defined in subprogram entities. Set to indicate that the subprogram -- is a machine code subprogram (i.e. its body includes at least one -- code statement). Also indicates that all necessary semantic checks @@ -2915,7 +2918,7 @@ package Einfo is -- Is_Modular_Integer_Type (synthesized) -- Applies to all entities. True if entity is a modular integer type --- Is_Non_Static_Subtype (Flag109) +-- Is_Non_Static_Subtype -- Defined in all type and subtype entities. It is set in some (but not -- all) cases in which a subtype is known to be non-static. Before this -- flag was added, the computation of whether a subtype was static was @@ -2931,7 +2934,7 @@ package Einfo is -- set right, at which point, these comments can be removed, and the -- tests for static subtypes greatly simplified. --- Is_Null_Init_Proc (Flag178) +-- Is_Null_Init_Proc -- Defined in procedure entities. Set for generated init proc procedures -- (used to initialize composite types), if the code for the procedure -- is null (i.e. is a return and nothing else). Such null initialization @@ -2952,11 +2955,11 @@ package Einfo is -- Applies to all entities, true for entities representing objects, -- including generic formal parameters. --- Is_Obsolescent (Flag153) +-- Is_Obsolescent -- Defined in all entities. Set for any entity to which a valid pragma -- or aspect Obsolescent applies. --- Is_Only_Out_Parameter (Flag226) +-- Is_Only_Out_Parameter -- Defined in formal parameter entities. Set if this parameter is the -- only OUT parameter for this formal part. If there is more than one -- out parameter, or if there is some other IN OUT parameter then this @@ -2966,7 +2969,7 @@ package Einfo is -- Applies to all entities, true for ordinary fixed point types and -- subtypes. --- Is_Package_Body_Entity (Flag160) +-- Is_Package_Body_Entity -- Defined in all entities. Set for entities defined at the top level -- of a package body. Used to control externally generated names. @@ -2974,7 +2977,7 @@ package Einfo is -- Applies to all entities. True for packages and generic packages. -- False for all other entities. --- Is_Packed (Flag51) [implementation base type only] +-- Is_Packed [implementation base type only] -- Defined in all type entities. This flag is set only for record and -- array types which have a packed representation. There are four cases -- which cause packing: @@ -3012,7 +3015,7 @@ package Einfo is -- Is_Packed_Array (synth) -- Applies to all entities, true if entity is for a packed array. --- Is_Packed_Array_Impl_Type (Flag138) +-- Is_Packed_Array_Impl_Type -- Defined in all entities. This flag is set on the entity for the type -- used to implement a packed array (either a modular type or a subtype -- of Packed_Bytes{1,2,4} in the bit-packed array case, a regular array @@ -3024,45 +3027,45 @@ package Einfo is -- set in an entity, then the Original_Array_Type field of this entity -- points to the array type for which this is the Packed_Array_Impl_Type. --- Is_Param_Block_Component_Type (Flag215) [base type only] +-- Is_Param_Block_Component_Type [base type only] -- Defined in access types. Set to indicate that a type is the type of a -- component of the parameter block record type generated by the compiler -- for an entry or a select statement. Read by CodePeer. --- Is_Partial_Invariant_Procedure (Flag292) +-- Is_Partial_Invariant_Procedure -- Defined in functions and procedures. Set for a generated invariant -- procedure which verifies the invariants of the partial view of a -- private type or private extension. --- Is_Potentially_Use_Visible (Flag9) +-- Is_Potentially_Use_Visible -- Defined in all entities. Set if entity is potentially use visible, -- i.e. it is defined in a package that appears in a currently active -- use clause (RM 8.4(8)). Note that potentially use visible entities -- are not necessarily use visible (RM 8.4(9-11)). --- Is_Predicate_Function (Flag255) +-- Is_Predicate_Function -- Present in functions and procedures. Set for generated predicate -- functions. --- Is_Predicate_Function_M (Flag256) +-- Is_Predicate_Function_M -- Present in functions and procedures. Set for special version of -- predicate function generated for use in membership tests, where -- raise expressions are transformed to return False. --- Is_Preelaborated (Flag59) +-- Is_Preelaborated -- Defined in all entities, set in E_Package and E_Generic_Package -- entities to which a pragma Preelaborate is applied, and also in -- all entities within such packages. Note that the fact that this -- flag is set does not necesarily mean that no elaboration code is -- generated for the package. --- Is_Primitive (Flag218) +-- Is_Primitive -- Defined in overloadable entities and in generic subprograms. Set to -- indicate that this is a primitive operation of some type, which may -- be a tagged type or an untagged type. Used to verify overriding -- indicators in bodies. --- Is_Primitive_Wrapper (Flag195) +-- Is_Primitive_Wrapper -- Defined in functions and procedures created by the expander to serve -- as an indirection mechanism to overriding primitives of concurrent -- types, entries and protected procedures. @@ -3071,19 +3074,19 @@ package Einfo is -- Applies to all entities, true for renamings of private protected -- components. Such entities appear as constants or variables. --- Is_Private_Composite (Flag107) +-- Is_Private_Composite -- Defined in composite types that have a private component. Used to -- enforce the rule that operations on the composite type that depend -- on the full view of the component, do not become visible until the -- immediate scope of the composite type itself (7.3.1 (5)). Both this -- flag and Is_Limited_Composite are needed. --- Is_Private_Descendant (Flag53) +-- Is_Private_Descendant -- Defined in entities that can represent library units (packages, -- functions, procedures). Set if the library unit is itself a private -- child unit, or if it is the descendant of a private child unit. --- Is_Private_Primitive (Flag245) +-- Is_Private_Primitive -- Defined in subprograms. Set if the operation is a primitive of a -- tagged type (procedure or function dispatching on result) whose -- full view has not been seen. Used in particular for primitive @@ -3110,14 +3113,14 @@ package Einfo is -- Is_Protected_Type (synthesized) -- Applies to all entities, true for protected types and subtypes --- Is_Public (Flag10) +-- Is_Public -- Defined in all entities. Set to indicate that an entity defined in -- one compilation unit can be referenced from other compilation units. -- If this reference causes a reference in the generated code, for -- example in the case of a variable name, then the backend will generate -- an appropriate external name for use by the linker. --- Is_Pure (Flag44) +-- Is_Pure -- Defined in all entities. Set in all entities of a unit to which a -- pragma Pure is applied except for non-intrinsic imported subprograms, -- and also set for the entity of the unit itself. In addition, this @@ -3127,16 +3130,16 @@ package Einfo is -- from side effects (other than those resulting from assignment to Out -- or In Out parameters, or to objects designated by access parameters). --- Is_Pure_Unit_Access_Type (Flag189) +-- Is_Pure_Unit_Access_Type -- Defined in access type and subtype entities. Set if the type or -- subtype appears in a pure unit. Used to give an error message at -- freeze time if the access type has a storage pool. --- Is_RACW_Stub_Type (Flag244) +-- Is_RACW_Stub_Type -- Defined in all types, true for the stub types generated for remote -- access-to-class-wide types. --- Is_Raised (Flag224) +-- Is_Raised -- Defined in exception entities. Set if the entity is referenced by a -- a raise statement. @@ -3151,29 +3154,29 @@ package Einfo is -- Applies to all entities, true for abstract states that are subject to -- option Relaxed_Initialization. --- Is_Remote_Call_Interface (Flag62) +-- Is_Remote_Call_Interface -- Defined in all entities. Set in E_Package and E_Generic_Package -- entities to which a pragma Remote_Call_Interface is applied, and -- also on entities declared in the visible part of such a package. --- Is_Remote_Types (Flag61) +-- Is_Remote_Types -- Defined in all entities. Set in E_Package and E_Generic_Package -- entities to which a pragma Remote_Types is applied, and also on -- entities declared in the visible part of the spec of such a package. -- Also set for types which are generic formal types to which the -- pragma Remote_Access_Type applies. --- Is_Renaming_Of_Object (Flag112) +-- Is_Renaming_Of_Object -- Defined in all entities, set only for a variable or constant for -- which the Renamed_Object field is non-empty and for which the -- renaming is handled by the front end, by macro substitution of -- a copy of the (evaluated) name tree whereever the variable is used. --- Is_Return_Object (Flag209) +-- Is_Return_Object -- Defined in all object entities. True if the object is the return -- object of an extended_return_statement; False otherwise. --- Is_Safe_To_Reevaluate (Flag249) +-- Is_Safe_To_Reevaluate -- Defined in all entities. Set in variables that are initialized by -- means of an assignment statement. When initialized their contents -- never change and hence they can be seen by the backend as constants. @@ -3182,7 +3185,7 @@ package Einfo is -- Is_Scalar_Type (synthesized) -- Applies to all entities, true for scalar types and subtypes --- Is_Shared_Passive (Flag60) +-- Is_Shared_Passive -- Defined in all entities. Set in E_Package and E_Generic_Package -- entities to which a pragma Shared_Passive is applied, and also in -- all entities within such packages. @@ -3197,7 +3200,7 @@ package Einfo is -- type is one of the standard string types (String, Wide_String, or -- Wide_Wide_String). --- Is_Static_Type (Flag281) +-- Is_Static_Type -- Defined in entities. Only set for (sub)types. If set, indicates that -- the type is known to be a static type (defined as a discrete type with -- static bounds, a record all of whose component types are static types, @@ -3205,7 +3208,7 @@ package Einfo is -- a component type that is a static type). See Set_Uplevel_Type for more -- information on how this flag is used. --- Is_Statically_Allocated (Flag28) +-- Is_Statically_Allocated -- Defined in all entities. This can only be set for exception, -- variable, constant, and type/subtype entities. If the flag is set, -- then the variable or constant must be allocated statically rather @@ -3244,13 +3247,13 @@ package Einfo is -- Applies to all entities, true for abstract states that are subject to -- option Synchronous. --- Is_Tag (Flag78) +-- Is_Tag -- Defined in E_Component and E_Constant entities. For regular tagged -- type this flag is set on the tag component (whose name is Name_uTag). -- For CPP_Class tagged types, this flag marks the pointer to the main -- vtable (i.e. the one to be extended by derivation). --- Is_Tagged_Type (Flag55) +-- Is_Tagged_Type -- Defined in all entities, set for an entity that is a tagged type -- Is_Task_Interface (synthesized) @@ -3264,7 +3267,7 @@ package Einfo is -- Is_Task_Type (synthesized) -- Applies to all entities. True for task types and subtypes --- Is_Thunk (Flag225) +-- Is_Thunk -- Defined in all entities. True for subprograms that are thunks: that is -- small subprograms built by the expander for tagged types that cover -- interface types. As part of the runtime call to an interface, thunks @@ -3277,13 +3280,13 @@ package Einfo is -- by Expand_Interface_Thunk and used by Expand_Call to handle extra -- actuals associated with accessibility level. --- Is_Trivial_Subprogram (Flag235) +-- Is_Trivial_Subprogram -- Defined in all entities. Set in subprograms where either the body -- consists of a single null statement, or the first or only statement -- of the body raises an exception. This is used for suppressing certain -- warnings, see Sem_Ch6.Analyze_Subprogram_Body discussion for details. --- Is_True_Constant (Flag163) +-- Is_True_Constant -- Defined in all entities for constants and variables. Set in constants -- and variables which have an initial value specified but which are -- never assigned, partially or in the whole. For variables, it means @@ -3296,27 +3299,27 @@ package Einfo is -- Is_Type (synthesized) -- Applies to all entities, true for a type entity --- Is_Unchecked_Union (Flag117) [implementation base type only] +-- Is_Unchecked_Union [implementation base type only] -- Defined in all entities. Set only in record types to which the -- pragma Unchecked_Union has been validly applied. --- Is_Underlying_Full_View (Flag298) +-- Is_Underlying_Full_View -- Defined in all entities. Set for types which represent the true full -- view of a private type completed by another private type. For further -- details, see attribute Underlying_Full_View. --- Is_Underlying_Record_View (Flag246) [base type only] +-- Is_Underlying_Record_View [base type only] -- Defined in all entities. Set only in record types that represent the -- underlying record view. This view is built for derivations of types -- with unknown discriminants; it is a record with the same structure -- as its corresponding record type, but whose parent is the full view -- of the parent in the original type extension. --- Is_Unimplemented (Flag284) +-- Is_Unimplemented -- Defined in all entities. Set for any entity to which a valid pragma -- or aspect Unimplemented applies. --- Is_Unsigned_Type (Flag144) +-- Is_Unsigned_Type -- Defined in all types, but can be set only for discrete and fixed-point -- type and subtype entities. This flag is only valid if the entity is -- frozen. If set it indicates that the representation is known to be @@ -3332,7 +3335,7 @@ package Einfo is -- cannot be used to determine the comparison operator to emit in the -- generated code: use the base type. --- Is_Uplevel_Referenced_Entity (Flag283) +-- Is_Uplevel_Referenced_Entity -- Defined in all entities. Used when unnesting subprograms to indicate -- that an entity is locally defined within a subprogram P, and there is -- a reference to the entity within a subprogram nested within P (at any @@ -3343,23 +3346,23 @@ package Einfo is -- array. This is used internally in Exp_Unst, see this package for -- further details. --- Is_Valued_Procedure (Flag127) +-- Is_Valued_Procedure -- Defined in procedure entities. Set if an Import_Valued_Procedure -- or Export_Valued_Procedure pragma applies to the procedure entity. --- Is_Visible_Formal (Flag206) +-- Is_Visible_Formal -- Defined in all entities. Set for instances of the formals of a -- formal package. Indicates that the entity must be made visible in the -- body of the instance, to reproduce the visibility of the generic. -- This simplifies visibility settings in instance bodies. --- Is_Visible_Lib_Unit (Flag116) +-- Is_Visible_Lib_Unit -- Defined in all (root or child) library unit entities. Once compiled, -- library units remain chained to the entities in the parent scope, and -- a separate flag must be used to indicate whether the names are visible -- by selected notation, or not. --- Is_Volatile (Flag16) +-- Is_Volatile -- Defined in all type entities, and also in constants, components and -- variables. Set if a pragma Volatile applies to the entity. Also set -- if pragma Shared or pragma Atomic applies to entity. In the case of @@ -3372,10 +3375,12 @@ package Einfo is -- Similarly, any front end test which is concerned with suppressing -- optimizations on volatile objects should test Treat_As_Volatile -- rather than testing this flag. --- ????This has been split into Is_Volatile_Type and Is_Volatile_Object, --- and function Is_Volatile is in Einfo.Utils. +-- This is a synthesized attribute in Einfo.Utils, based on +-- Is_Volatile_Type and Is_Volatile_Object. The latter two should be +-- used in preference to Is_Volatile when we know that we have a type +-- or an object. --- Is_Volatile_Full_Access (Flag285) +-- Is_Volatile_Full_Access -- Defined in all type entities, and also in constants, components, and -- variables. Set if an aspect/pragma Volatile_Full_Access or an Ada 2022 -- aspect Full_Access_Only applies to the entity. In the case of private @@ -3386,26 +3391,26 @@ package Einfo is -- Defined in package entities. Indicates that the package has been -- created as a wrapper for a subprogram instantiation. --- Itype_Printed (Flag202) +-- Itype_Printed -- Defined in all type and subtype entities. Set in Itypes if the Itype -- has been printed by Sprint. This is used to avoid printing an Itype -- more than once. --- Kill_Elaboration_Checks (Flag32) +-- Kill_Elaboration_Checks -- Defined in all entities. Set by the expander to kill elaboration -- checks which are known not to be needed. Equivalent in effect to -- the use of pragma Suppress (Elaboration_Checks) for that entity -- except that the effect is permanent and cannot be undone by a -- subsequent pragma Unsuppress. --- Kill_Range_Checks (Flag33) +-- Kill_Range_Checks -- Defined in all entities. Equivalent in effect to the use of pragma -- Suppress (Range_Checks) for that entity except that the result is -- permanent and cannot be undone by a subsequent pragma Unsuppress. -- This is currently only used in one odd situation in Sem_Ch3 for -- record types, and it would be good to get rid of it??? --- Known_To_Have_Preelab_Init (Flag207) +-- Known_To_Have_Preelab_Init -- Defined in all type and subtype entities. If set, then the type is -- known to have preelaborable initialization. In the case of a partial -- view of a private type, it is only possible for this to be set if a @@ -3414,20 +3419,20 @@ package Einfo is -- initialization, it may or may not be set if the type does have -- preelaborable initialization. --- Last_Aggregate_Assignment (Node30) +-- Last_Aggregate_Assignment -- Applies to controlled constants and variables initialized by an -- aggregate. Points to the last statement associated with the expansion -- of the aggregate. The attribute is used by the finalization machinery -- when marking an object as successfully initialized. --- Last_Assignment (Node26) +-- Last_Assignment -- Defined in entities for variables, and OUT or IN OUT formals. Set for -- a local variable or formal to point to the left side of an assignment -- statement assigning a value to the variable. Cleared if the value of -- the entity is referenced. Used to warn about dubious assignment -- statements whose value is not used. --- Last_Entity (Node20) +-- Last_Entity -- Defined in all entities which act as scopes to which a list of -- associated entities is attached (blocks, class subtypes and types, -- entries, functions, loops, packages, procedures, protected objects, @@ -3442,42 +3447,42 @@ package Einfo is -- a subprogram type (the designated type of an Access_To_Subprogram -- definition) or in an entry. --- Limited_View (Node23) +-- Limited_View -- Defined in non-generic package entities that are not instances. Bona -- fide package with the limited-view list through the first_entity and -- first_private attributes. The elements of this list are the shadow -- entities created for the types and local packages that are declared -- in a package appearing in a limited_with clause (Ada 2005: AI-50217). --- Linker_Section_Pragma (Node33) +-- Linker_Section_Pragma -- Present in constant, variable, type and subprogram entities. Points -- to a linker section pragma that applies to the entity, or is Empty if -- no such pragma applies. Note that for constants and variables, this -- field may be set as a result of a linker section pragma applied to the -- type of the object. --- Lit_Hash (Node21) +-- Lit_Hash -- Defined in enumeration types and subtypes. Non-empty only for the -- case of an enumeration root type, where it contains the entity for -- the generated hash function. See unit Exp_Imgv for full details of -- the nature and use of this entity for implementing the Value -- attribute for the enumeration type in question. --- Lit_Indexes (Node18) +-- Lit_Indexes -- Defined in enumeration types and subtypes. Non-empty only for the -- case of an enumeration root type, where it contains the entity for -- the generated indexes entity. See unit Exp_Imgv for full details of -- the nature and use of this entity for implementing the Image and -- Value attributes for the enumeration type in question. --- Lit_Strings (Node16) +-- Lit_Strings -- Defined in enumeration types and subtypes. Non-empty only for the -- case of an enumeration root type, where it contains the entity for -- the literals string entity. See unit Exp_Imgv for full details of -- the nature and use of this entity for implementing the Image and -- Value attributes for the enumeration type in question. --- Low_Bound_Tested (Flag205) +-- Low_Bound_Tested -- Defined in all entities. Currently this can only be set for formal -- parameter entries of a standard unconstrained one-dimensional array -- or string type. Indicates that an explicit test of the low bound of @@ -3485,14 +3490,14 @@ package Einfo is -- flag is set, warnings about assuming the index low bound to be one -- are suppressed. --- Machine_Radix_10 (Flag84) +-- Machine_Radix_10 -- Defined in decimal types and subtypes, set if the Machine_Radix is 10, -- as the result of the specification of a machine radix representation -- clause. Note that it is possible for this flag to be set without -- having Has_Machine_Radix_Clause True. This happens when a type is -- derived from a type with a clause present. --- Master_Id (Node17) +-- Master_Id -- Defined in access types and subtypes. Empty unless Has_Task is set for -- the designated type, in which case it points to the entity for the -- Master_Id for the access type master. Also set for access-to-limited- @@ -3500,13 +3505,13 @@ package Einfo is -- for access-to-limited-interfaces because they can be used to reference -- tasks implementing such interface. --- Materialize_Entity (Flag168) +-- Materialize_Entity -- Defined in all entities. Set only for renamed obects which should be -- materialized for debugging purposes. This means that a memory location -- containing the renamed address should be allocated. This is needed so -- that the debugger can find the entity. --- May_Inherit_Delayed_Rep_Aspects (Flag262) +-- May_Inherit_Delayed_Rep_Aspects -- Defined in all entities for types and subtypes. Set if the type is -- derived from a type which has delayed rep aspects (marked by the flag -- Has_Delayed_Rep_Aspects being set). In this case, at the freeze point @@ -3514,14 +3519,14 @@ package Einfo is -- a given attribute has not been set for the derived type, we copy the -- value from the parent type. See Freeze.Inherit_Delayed_Rep_Aspects. --- Mechanism (Uint8) (returned as Mechanism_Type) +-- Mechanism (returned as Mechanism_Type) -- Defined in functions and non-generic formal parameters. Indicates -- the mechanism to be used for the function return or for the formal -- parameter. See full description in the spec of Sem_Mech. This field -- is also set (to the default value of zero = Default_Mechanism) in a -- subprogram body entity but not used in this context. --- Minimum_Accessibility (Node24) +-- Minimum_Accessibility -- Defined in formal parameters in the non-generic case. Normally Empty, -- but if expansion is active, and a parameter exists for which a -- dynamic accessibility check is required, then an object is generated @@ -3529,12 +3534,12 @@ package Einfo is -- subprogram or the formal's Extra_Accessibility - whichever one is -- lesser. The Minimum_Accessibility field then points to this object. --- Modulus (Uint17) [base type only] +-- Modulus [base type only] -- Defined in modular types. Contains the modulus. For the binary case, -- this will be a power of 2, but if Non_Binary_Modulus is set, then it -- will not be a power of 2. --- Must_Be_On_Byte_Boundary (Flag183) +-- Must_Be_On_Byte_Boundary -- Defined in entities for types and subtypes. Set if objects of the type -- must always be allocated on a byte boundary (more accurately a storage -- unit boundary). The front end checks that component clauses respect @@ -3542,19 +3547,19 @@ package Einfo is -- violate this rule. Currently the flag is set only for packed arrays -- longer than 64 bits where the component size is not a power of 2. --- Must_Have_Preelab_Init (Flag208) +-- Must_Have_Preelab_Init -- Defined in entities for types and subtypes. Set in the full type of a -- private type or subtype if a pragma Has_Preelaborable_Initialization -- is present for the private type. Used to check that the full type has -- preelaborable initialization at freeze time (this has to be deferred -- to the freeze point because of the rule about overriding Initialize). --- Needs_Activation_Record (Flag306) +-- Needs_Activation_Record -- Defined on generated subprogram types. Indicates that a call through -- a named or anonymous access to subprogram requires an activation -- record when compiling with unnesting for C or LLVM. --- Needs_Debug_Info (Flag147) +-- Needs_Debug_Info -- Defined in all entities. Set if the entity requires normal debugging -- information to be generated. This is true of all entities that have -- Comes_From_Source set, and also transitively for entities associated @@ -3565,7 +3570,7 @@ package Einfo is -- use Sem_Util.Set_Debug_Info_Needed, rather than Set_Needs_Debug_Info, -- so that the flag is set properly on subsidiary entities. --- Needs_No_Actuals (Flag22) +-- Needs_No_Actuals -- Defined in callable entities (subprograms, entries, access to -- subprograms) which can be called without actuals because all of -- their formals (if any) have default values. This flag simplifies the @@ -3574,7 +3579,7 @@ package Einfo is -- interpreted as an indexing of the result of the call. It is also -- used to resolve various cases of entry calls. --- Never_Set_In_Source (Flag115) +-- Never_Set_In_Source -- Defined in all entities, but can be set only for variables and -- parameters. This flag is set if the object is never assigned a value -- in user source code, either by assignment or by being used as an out @@ -3637,7 +3642,7 @@ package Einfo is -- might be the only components of the record. Returns Empty if there -- are no more discriminants. --- Next_Entity (Node2) +-- Next_Entity -- Defined in all entities. The entities of a scope are chained, with -- the head of the list being in the First_Entity field of the scope -- entity. All entities use the Next_Entity field as a forward pointer @@ -3665,7 +3670,7 @@ package Einfo is -- unlike most attributes in this package, Next_Index applies to -- nodes for the indexes, not to entities. --- Next_Inlined_Subprogram (Node12) +-- Next_Inlined_Subprogram -- Defined in subprograms. Used to chain inlined subprograms used in -- the current compilation, in the order in which they must be compiled -- by the backend to ensure that all inlinings are performed. @@ -3675,32 +3680,32 @@ package Einfo is -- Empty if applied to the last literal. This is actually a synonym -- for Next, but its use is preferred in this context. --- No_Dynamic_Predicate_On_Actual (Flag276) +-- No_Dynamic_Predicate_On_Actual -- Defined in discrete types. Set for generic formal types that are used -- in loops and quantified expressions. The corresponing actual cannot -- have dynamic predicates. --- No_Pool_Assigned (Flag131) [root type only] +-- No_Pool_Assigned [root type only] -- Defined in access types. Set if a storage size clause applies to the -- variable with a static expression value of zero. This flag is used to -- generate errors if any attempt is made to allocate or free an instance -- of such an access type. This is set only in the root type, since -- derived types must have the same pool. --- No_Predicate_On_Actual (Flag275) +-- No_Predicate_On_Actual -- Defined in discrete types. Set for generic formal types that are used -- in the spec of a generic package, in constructs that forbid discrete -- types with predicates. --- No_Reordering (Flag239) [implementation base type only] +-- No_Reordering [implementation base type only] -- Defined in record types. Set only for a base type to which a valid -- pragma No_Component_Reordering applies. --- No_Return (Flag113) +-- No_Return -- Defined in all entities. Set for subprograms and generic subprograms -- to which a valid aspect or pragma No_Return applies. --- No_Strict_Aliasing (Flag136) [base type only] +-- No_Strict_Aliasing [base type only] -- Defined in access types. Set to direct the backend to avoid any -- optimizations based on an assumption about the aliasing status of -- objects designated by the access type. For the case of the gcc @@ -3710,38 +3715,38 @@ package Einfo is -- type occurs in the same source unit as the declaration of the -- access type, or if an explicit pragma No_Strict_Aliasing applies. --- No_Tagged_Streams_Pragma (Node32) +-- No_Tagged_Streams_Pragma -- Present in all subtype and type entities. Set for tagged types and -- subtypes (i.e. entities with Is_Tagged_Type set True) if a valid -- pragma/aspect applies to the type. --- Non_Binary_Modulus (Flag58) [base type only] +-- Non_Binary_Modulus [base type only] -- Defined in all subtype and type entities. Set for modular integer -- types if the modulus value is other than a power of 2. --- Non_Limited_View (Node19) +-- Non_Limited_View -- Defined in abstract states and incomplete types that act as shadow -- entities created when analysing a limited with clause (Ada 2005: -- AI-50217). Points to the defining entity of the original declaration. --- Nonzero_Is_True (Flag162) [base type only] +-- Nonzero_Is_True [base type only] -- Defined in enumeration types. Set if any non-zero value is to be -- interpreted as true. Currently this is set for derived Boolean -- types which have a convention of C, C++ or Fortran. --- Normalized_First_Bit (Uint8) +-- Normalized_First_Bit -- Defined in components and discriminants. Indicates the normalized -- value of First_Bit for the component, i.e. the offset within the -- lowest addressed storage unit containing part or all of the field. -- Set to No_Uint if no first bit position is assigned yet. --- Normalized_Position (Uint14) +-- Normalized_Position -- Defined in components and discriminants. Indicates the normalized -- value of Position for the component, i.e. the offset in storage -- units from the start of the record to the lowest addressed storage -- unit containing part or all of the field. --- Normalized_Position_Max (Uint10) +-- Normalized_Position_Max -- Defined in components and discriminants. For almost all cases, this -- is the same as Normalized_Position. The one exception is for the case -- of a discriminated record containing one or more arrays whose length @@ -3773,7 +3778,7 @@ package Einfo is -- representation item chain is copied for a derived type, it can inherit -- an object size clause that is not applicable to the entity. --- OK_To_Rename (Flag247) +-- OK_To_Rename -- Defined only in entities for variables. If this flag is set, it -- means that if the entity is used as the initial value of an object -- declaration, the object declaration can be safely converted into a @@ -3784,7 +3789,7 @@ package Einfo is -- is only worth setting this flag for composites, since for primitive -- types, it is cheaper to do the copy. --- Optimize_Alignment_Space (Flag241) +-- Optimize_Alignment_Space -- Defined in type, subtype, variable, and constant entities. This -- flag records that the type or object is to be laid out in a manner -- consistent with Optimize_Alignment (Space) mode. The compiler and @@ -3792,7 +3797,7 @@ package Einfo is -- Optimize_Alignment (Off) mode applies to the type/object, then neither -- of the flags Optimize_Alignment_Space/Optimize_Alignment_Time is set. --- Optimize_Alignment_Time (Flag242) +-- Optimize_Alignment_Time -- Defined in type, subtype, variable, and constant entities. This -- flag records that the type or object is to be laid out in a manner -- consistent with Optimize_Alignment (Time) mode. The compiler and @@ -3800,25 +3805,25 @@ package Einfo is -- Optimize_Alignment (Off) mode applies to the type/object, then neither -- of the flags Optimize_Alignment_Space/Optimize_Alignment_Time is set. --- Original_Access_Type (Node28) +-- Original_Access_Type -- Defined in E_Access_Subprogram_Type entities. Set only if the access -- type was generated by the expander as part of processing an access- -- to-protected-subprogram type. Points to the access-to-protected- -- subprogram type. --- Original_Array_Type (Node21) +-- Original_Array_Type -- Defined in modular types and array types and subtypes. Set only if -- the Is_Packed_Array_Impl_Type flag is set, indicating that the type -- is the implementation type for a packed array, and in this case it -- points to the original array type for which this is the packed -- array implementation type. --- Original_Protected_Subprogram (Node41) +-- Original_Protected_Subprogram -- Defined in functions and procedures. Set only on internally built -- dispatching subprograms of protected types to reference their original -- non-dispatching protected subprogram since their names differ. --- Original_Record_Component (Node22) +-- Original_Record_Component -- Defined in components, including discriminants. The usage depends -- on whether the record is a base type and whether it is tagged. -- @@ -3838,12 +3843,12 @@ package Einfo is -- In subtypes (tagged and untagged): -- Points to the component in the base type. --- Overlays_Constant (Flag243) +-- Overlays_Constant -- Defined in all entities. Set only for E_Constant or E_Variable for -- which there is an address clause that causes the entity to overlay -- a constant object. --- Overridden_Operation (Node26) +-- Overridden_Operation -- Defined in subprograms. For overriding operations, points to the -- user-defined parent subprogram that is being overridden. Note: this -- attribute uses the same field as Static_Initialization. The latter @@ -3851,7 +3856,7 @@ package Einfo is -- Overridden_Operation is irrelevant. Thus this attribute must not be -- set for init_procs. --- Package_Instantiation (Node26) +-- Package_Instantiation -- Defined in packages and generic packages. When defined, this field -- references an N_Generic_Instantiation node associated with an -- instantiated package. In the case where the referenced node has @@ -3863,7 +3868,7 @@ package Einfo is -- it should be set in all cases, including package entities associated -- with formal packages. ??? --- Packed_Array_Impl_Type (Node23) +-- Packed_Array_Impl_Type -- Defined in array types and subtypes, except for the string literal -- subtype case, if the corresponding type is packed and implemented -- specially (either bit-packed or packed to eliminate holes in the @@ -3881,17 +3886,17 @@ package Einfo is -- used when obtaining the formal kind of a formal parameter (the result -- is one of E_[In/Out/In_Out]_Parameter). --- Parent_Subtype (Node19) [base type only] +-- Parent_Subtype [base type only] -- Defined in E_Record_Type. Set only for derived tagged types, in which -- case it points to the subtype of the parent type. This is the type -- that is used as the Etype of the _parent field. --- Part_Of_Constituents (Elist10) +-- Part_Of_Constituents -- Present in abstract state and variable entities. Contains all -- constituents that are subject to indicator Part_Of (both aspect and -- option variants). --- Part_Of_References (Elist11) +-- Part_Of_References -- Present in variable entities. Contains all references to the variable -- when it is subject to pragma Part_Of. If the variable is a constituent -- of a single protected/task type, the references are examined as they @@ -3930,12 +3935,12 @@ package Einfo is -- abstract states with no or only partial refinement visible, and those -- that are not themselves abstract states. --- Partial_View_Has_Unknown_Discr (Flag280) +-- Partial_View_Has_Unknown_Discr -- Present in all types. Set to Indicate that the partial view of a type -- has unknown discriminants. A default initialization of an object of -- the type does not require an invariant check (AI12-0133). --- Pending_Access_Types (Elist15) +-- Pending_Access_Types -- Defined in all types. Set for incomplete, private, Taft-amendment -- types, and their corresponding full views. This list contains all -- access types, both named and anonymous, declared between the partial @@ -3943,7 +3948,7 @@ package Einfo is -- ensure that the finalization masters of all pending access types are -- fully initialized when the full view is frozen. --- Postconditions_Proc (Node14) +-- Postconditions_Proc -- Defined in functions, procedures, entries, and entry families. Refers -- to the entity of the _Postconditions procedure used to check contract -- assertions on exit from a subprogram. @@ -3972,7 +3977,7 @@ package Einfo is -- is the special version created for membership tests, where if one of -- these raise expressions is executed, the result is to return False. --- Predicated_Parent (Node38) +-- Predicated_Parent -- Defined on itypes created by subtype indications, when the parent -- subtype has predicates. The itype shares the Predicate_Function -- of the predicated parent, but this function may not have been built @@ -3980,12 +3985,12 @@ package Einfo is -- retrieval at the point a predicate check needs to be generated. -- The utility Predicate_Function takes this link into account. --- Predicates_Ignored (Flag288) +-- Predicates_Ignored -- Defined on all types. Indicates whether the subtype declaration is in -- a context where Assertion_Policy is Ignore, in which case no checks -- (static or dynamic) must be generated for objects of the type. --- Prev_Entity (Node36) +-- Prev_Entity -- Defined in all entities. The entities of a scope are chained, and this -- field is used as a backward pointer for this entity list - effectivly -- making the entity chain doubly-linked. @@ -3997,16 +4002,16 @@ package Einfo is -- Direct_Primitive_Operations of its CRT; otherwise returns No_Elist. -- For all the other types returns the Direct_Primitive_Operations. --- Prival (Node17) +-- Prival -- Defined in private components of protected types. Refers to the entity -- of the component renaming declaration generated inside protected -- subprograms, entries or barrier functions. --- Prival_Link (Node20) +-- Prival_Link -- Defined in constants and variables which rename private components of -- protected types. Set to the original private component. --- Private_Dependents (Elist18) +-- Private_Dependents -- Defined in private (sub)types. Records the subtypes of the private -- type, derivations from it, and records and arrays with components -- dependent on the type. @@ -4026,62 +4031,62 @@ package Einfo is -- declaration of the type is seen. Subprograms that have such an -- access parameter are also placed in the list of private_dependents. --- Protected_Body_Subprogram (Node11) +-- Protected_Body_Subprogram -- Defined in protected operations. References the entity for the -- subprogram which implements the body of the operation. --- Protected_Formal (Node22) +-- Protected_Formal -- Defined in formal parameters (in, in out and out parameters). Used -- only for formals of protected operations. References corresponding -- formal parameter in the unprotected version of the operation that -- is created during expansion. --- Protected_Subprogram (Node39) +-- Protected_Subprogram -- Defined in functions and procedures. Set for the pair of subprograms -- which emulate the runtime semantics of a protected subprogram. Denotes -- the entity of the origial protected subprogram. --- Protection_Object (Node23) +-- Protection_Object -- Applies to protected entries, entry families and subprograms. Denotes -- the entity which is used to rename the _object component of protected -- types. --- Reachable (Flag49) +-- Reachable -- Defined in labels. The flag is set over the range of statements in -- which a goto to that label is legal. --- Receiving_Entry (Node19) +-- Receiving_Entry -- Defined in procedures. Set for an internally generated procedure which -- wraps the original statements of an accept alternative. Designates the -- entity of the task entry being accepted. --- Referenced (Flag156) +-- Referenced -- Defined in all entities. Set if the entity is referenced, except for -- the case of an appearance of a simple variable that is not a renaming -- as the left side of an assignment in which case Referenced_As_LHS is -- set instead, or a similar appearance as an out parameter actual, in -- which case Referenced_As_Out_Parameter is set. --- Referenced_As_LHS (Flag36): +-- Referenced_As_LHS : -- Defined in all entities. This flag is set instead of Referenced if a -- simple variable that is not a renaming appears as the left side of an -- assignment. The reason we distinguish this kind of reference is that -- we have a separate warning for variables that are only assigned and -- never read. --- Referenced_As_Out_Parameter (Flag227): +-- Referenced_As_Out_Parameter : -- Defined in all entities. This flag is set instead of Referenced if a -- simple variable that is not a renaming appears as an actual for an out -- formal. The reason we distinguish this kind of reference is that -- we have a separate warning for variables that are only assigned and -- never read, and out parameters are a special case. --- Refinement_Constituents (Elist8) +-- Refinement_Constituents -- Present in abstract state entities. Contains all the constituents that -- refine the state, in other words, all the hidden states that appear in -- the constituent_list of aspect/pragma Refined_State. --- Register_Exception_Call (Node20) +-- Register_Exception_Call -- Defined in exception entities. When an exception is declared, -- a call is expanded to Register_Exception. This field points to -- the expanded N_Procedure_Call_Statement node for this call. It @@ -4089,13 +4094,13 @@ package Einfo is -- register call to make appropriate entries in the special tables -- used for handling these pragmas at run time. --- Related_Array_Object (Node25) +-- Related_Array_Object -- Defined in array types and subtypes. Used only for the base type -- and subtype created for an anonymous array object. Set to point -- to the entity of the corresponding array object. Currently used -- only for type-related error messages. --- Related_Expression (Node24) +-- Related_Expression -- Defined in variables, types and functions. When Set for internally -- generated entities, it may be used to denote the source expression -- whose elaboration created the variable declaration. If set, it is used @@ -4110,37 +4115,37 @@ package Einfo is -- Shouldn't it also be used for the same purpose in errout? It seems -- odd to have two mechanisms here??? --- Related_Instance (Node15) +-- Related_Instance -- Defined in the wrapper packages created for subprogram instances. -- The internal subprogram that implements the instance is inside the -- wrapper package, but for debugging purposes its external symbol -- must correspond to the name and scope of the related instance. --- Related_Type (Node27) +-- Related_Type -- Defined in components, constants and variables. Set when there is an -- associated dispatch table to point to entities containing primary or -- secondary tags. Not set in the _tag component of record types. --- Relative_Deadline_Variable (Node28) [implementation base type only] +-- Relative_Deadline_Variable [implementation base type only] -- Defined in task type entities. This flag is set if a valid and -- effective pragma Relative_Deadline applies to the base type. Points -- to the entity for a variable that is created to hold the value given -- in a Relative_Deadline pragma for a task type. --- Renamed_Entity (Node18) +-- Renamed_Entity -- Defined in exception, generic unit, package, and subprogram entities. -- Set when the entity is defined by a renaming declaration. Denotes the -- renamed entity, or transitively the ultimate renamed entity if there -- is a chain of renaming declarations. Empty if no renaming. --- Renamed_In_Spec (Flag231) +-- Renamed_In_Spec -- Defined in package entities. If a package renaming occurs within -- a package spec, then this flag is set on the renamed package. The -- purpose is to prevent a warning about unused entities in the renamed -- package. Such a warning would be inappropriate since clients of the -- package can see the entities in the package via the renaming. --- Renamed_Object (Node18) +-- Renamed_Object -- Defined in components, constants, discriminants, formal parameters, -- generic formals, loop parameters, and variables. Set to non-Empty if -- the object was declared by a renaming declaration. For constants and @@ -4152,7 +4157,7 @@ package Einfo is -- within an accept statement. For all remaining cases (discriminants, -- loop parameters) the field is Empty. --- Renaming_Map (Uint9) +-- Renaming_Map -- Defined in generic subprograms, generic packages, and their -- instances. Also defined in the instances of the corresponding -- bodies. Denotes the renaming map (generic entities => instance @@ -4161,13 +4166,13 @@ package Einfo is -- details. The maps for package instances are also used when the -- instance is the actual corresponding to a formal package. --- Requires_Overriding (Flag213) +-- Requires_Overriding -- Defined in all subprograms and entries. Set for subprograms that -- require overriding as defined by RM-2005-3.9.3(6/2). Note that this -- is True only for implicitly declared subprograms; it is not set on the -- parent type's subprogram. See also Is_Abstract_Subprogram. --- Return_Applies_To (Node8) +-- Return_Applies_To -- Defined in E_Return_Statement. Points to the entity representing -- the construct to which the return statement applies, as defined in -- RM-6.5(4/2). Note that a (simple) return statement within an @@ -4178,20 +4183,20 @@ package Einfo is -- by Expand_N_Extended_Return_Statement before being turned into an -- E_Block by semantic analysis. --- Return_Present (Flag54) +-- Return_Present -- Defined in function and generic function entities. Set if the -- function contains a return statement (used for error checking). -- This flag can also be set in procedure and generic procedure -- entities (for convenience in setting it), but is only tested -- for the function case. --- Returns_By_Ref (Flag90) +-- Returns_By_Ref -- Defined in subprogram type entities and functions. Set if a function -- (or an access-to-function type) returns a result by reference, either -- because its return type is a by-reference-type or because the function -- explicitly uses the secondary stack. --- Reverse_Bit_Order (Flag164) [base type only] +-- Reverse_Bit_Order [base type only] -- Defined in all record type entities. Set if entity has a Bit_Order -- aspect (set by an aspect clause or attribute definition clause) that -- has reversed the order of bits from the default value. When this flag @@ -4199,7 +4204,7 @@ package Einfo is -- a single storage unit (Ada 95) or within a single machine scalar (see -- Ada 2005 AI-133), or must occupy an integral number of storage units. --- Reverse_Storage_Order (Flag93) [base type only] +-- Reverse_Storage_Order [base type only] -- Defined in all record and array type entities. Set if entity has a -- Scalar_Storage_Order aspect (set by an aspect clause or attribute -- definition clause) that has reversed the order of storage elements @@ -4207,13 +4212,13 @@ package Einfo is -- the Bit_Order aspect must be set to the same value (either explicitly -- or as the target default value). --- Rewritten_For_C (Flag287) +-- Rewritten_For_C -- Defined on functions that return a constrained array type, when -- Modify_Tree_For_C is set. Indicates that a procedure with an extra -- out parameter has been created for it, and calls must be rewritten as -- calls to the new procedure. --- RM_Size (Uint13) +-- RM_Size -- Defined in all type and subtype entities. Contains the value of -- type'Size as defined in the RM. See also the Esize field and -- and the description on "Handling of Type'Size Values". A value @@ -4232,7 +4237,7 @@ package Einfo is -- does not correspond exactly to the use of root type in the RM, since -- in the RM root type applies to a class of types, not to a type. --- Scalar_Range (Node20) +-- Scalar_Range -- Defined in all scalar types (including modular types, where the -- bounds are 0 .. modulus - 1). References a node in the tree that -- contains the bounds for the range. Note that this information @@ -4243,13 +4248,13 @@ package Einfo is -- but not a simple subtype reference (a subtype is converted into a -- explicit range). --- Scale_Value (Uint16) +-- Scale_Value -- Defined in decimal fixed-point types and subtypes. This holds the -- value of the Scale attribute for the type, i.e. the scale of the type -- defined as the integer N such that the delta is equal to 10.0**(-N). -- Note that, if Scale_Value is positive, then it is equal to Aft_Value. --- Scope (Node3) +-- Scope -- Defined in all entities. Points to the entity for the scope (block, -- loop, subprogram, package etc.) in which the entity is declared. -- Since this field is in the base part of the entity node, the access @@ -4265,7 +4270,7 @@ package Einfo is -- simply the scope depth value, for record entities, it is the -- Scope_Depth of the record scope. --- Scope_Depth_Value (Uint22) +-- Scope_Depth_Value -- Defined in program units, blocks, loops, return statements, -- concurrent types, private types and entries. -- Indicates the number of scopes that statically enclose the declaration @@ -4278,18 +4283,18 @@ package Einfo is -- indicating whether or not the Scope_Depth field has been set. It is -- needed, since returns an invalid value in this case. --- Sec_Stack_Needed_For_Return (Flag167) +-- Sec_Stack_Needed_For_Return -- Defined in scope entities (blocks, entries, entry families, functions, -- and procedures). Set to True when secondary stack is used to hold the -- returned value of a function and thus should not be released on scope -- exit. --- Shared_Var_Procs_Instance (Node22) +-- Shared_Var_Procs_Instance -- Defined in variables. Set non-Empty only if Is_Shared_Passive is -- set, in which case this is the entity for the associated instance of -- System.Shared_Storage.Shared_Var_Procs. See Exp_Smem for full details. --- Size_Check_Code (Node19) +-- Size_Check_Code -- Defined in constants and variables. Normally Empty. Set if code is -- generated to check the size of the object. This field is used to -- suppress this code if a subsequent address clause is encountered. @@ -4303,13 +4308,13 @@ package Einfo is -- chain is copied for a derived type, it can inherit a size clause that -- is not applicable to the entity. --- Size_Depends_On_Discriminant (Flag177) +-- Size_Depends_On_Discriminant -- Defined in all entities for types and subtypes. Indicates that the -- size of the type depends on the value of one or more discriminants. -- Currently, this flag is only set for arrays which have one or more -- bounds depending on a discriminant value. --- Size_Known_At_Compile_Time (Flag92) +-- Size_Known_At_Compile_Time -- Defined in all entities for types and subtypes. Indicates that the -- size of objects of the type is known at compile time. This flag is -- used to optimize some generated code sequences, and also to enable @@ -4321,12 +4326,12 @@ package Einfo is -- to the back end, so the fact that this flag is set does not mean that -- the front end can access the value. --- Small_Value (Ureal21) +-- Small_Value -- Defined in fixed point types. Points to the universal real for the -- Small of the type, either as given in a representation clause, or -- as computed (as a power of two) by the compiler. --- SPARK_Aux_Pragma (Node41) +-- SPARK_Aux_Pragma -- Present in concurrent type, [generic] package spec and package body -- entities. For concurrent types and package specs it refers to the -- SPARK mode setting for the private part. This field points to the @@ -4337,12 +4342,12 @@ package Einfo is -- inherited from the enclosing context. In all cases, if the pragma is -- inherited, then the SPARK_Aux_Pragma_Inherited flag is set. --- SPARK_Aux_Pragma_Inherited (Flag266) +-- SPARK_Aux_Pragma_Inherited -- Present in concurrent type, [generic] package spec and package body -- entities. Set if the SPARK_Aux_Pragma field points to a pragma that is -- inherited, rather than a local one. --- SPARK_Pragma (Node40) +-- SPARK_Pragma -- Present in the following entities: -- -- abstract states @@ -4363,7 +4368,7 @@ package Einfo is -- flag SPARK_Pragma_Inherited is set. Empty if no SPARK_Mode pragma is -- applicable. --- SPARK_Pragma_Inherited (Flag265) +-- SPARK_Pragma_Inherited -- Present in the following entities: -- -- abstract states @@ -4380,23 +4385,23 @@ package Einfo is -- Set if the SPARK_Pragma attribute points to an inherited pragma rather -- than a local one. --- Spec_Entity (Node19) +-- Spec_Entity -- Defined in package body entities. Points to corresponding package -- spec entity. Also defined in subprogram body parameters in the -- case where there is a separate spec, where this field references -- the corresponding parameter entities in the spec. --- SSO_Set_High_By_Default (Flag273) [base type only] +-- SSO_Set_High_By_Default [base type only] -- Defined for record and array types. Set in the base type if a pragma -- Default_Scalar_Storage_Order (High_Order_First) was active at the time -- the record or array was declared and therefore applies to it. --- SSO_Set_Low_By_Default (Flag272) [base type only] +-- SSO_Set_Low_By_Default [base type only] -- Defined for record and array types. Set in the base type if a pragma -- Default_Scalar_Storage_Order (High_Order_First) was active at the time -- the record or array was declared and therefore applies to it. --- Static_Discrete_Predicate (List25) +-- Static_Discrete_Predicate -- Defined in discrete types/subtypes with static predicates (with the -- two flags Has_Predicates and Has_Static_Predicate set). Set if the -- type/subtype has a static predicate. Points to a list of expression @@ -4407,13 +4412,13 @@ package Einfo is -- are fully analyzed and typed with the base type of the subtype. Note -- that all entries are static and have values within the subtype range. --- Static_Elaboration_Desired (Flag77) +-- Static_Elaboration_Desired -- Defined in library-level packages. Set by the pragma of the same -- name, to indicate that static initialization must be attempted for -- all types declared in the package, and that a warning must be emitted -- for those types to which static initialization is not available. --- Static_Initialization (Node30) +-- Static_Initialization -- Defined in initialization procedures for types whose objects can be -- initialized statically. The value of this attribute is a positional -- aggregate whose components are compile-time static values. Used @@ -4422,7 +4427,7 @@ package Einfo is -- This attribute uses the same field as Overridden_Operation, which is -- irrelevant in init_procs. --- Static_Real_Or_String_Predicate (Node25) +-- Static_Real_Or_String_Predicate -- Defined in real types/subtypes with static predicates (with the two -- flags Has_Predicates and Has_Static_Predicate set). Set if the type -- or subtype has a static predicate. Points to the return expression @@ -4442,7 +4447,7 @@ package Einfo is -- from another predicate but does not add a predicate of its own, the -- expression may consist of the above xxxPredicate call on its own. --- Status_Flag_Or_Transient_Decl (Node15) +-- Status_Flag_Or_Transient_Decl -- Defined in constant, loop, and variable entities. Applies to objects -- that require special treatment by the finalization machinery, such as -- extended return results, IF and CASE expression results, and objects @@ -4451,7 +4456,7 @@ package Einfo is -- code or the declaration of a "hook" object. -- In which case is it a flag, or a hook object??? --- Storage_Size_Variable (Node26) [implementation base type only] +-- Storage_Size_Variable [implementation base type only] -- Defined in access types and task type entities. This flag is set -- if a valid and effective pragma Storage_Size applies to the base -- type. Points to the entity for a variable that is created to @@ -4460,36 +4465,36 @@ package Einfo is -- this field is defined only in the root type (since derived types -- share the same storage pool). --- Stored_Constraint (Elist23) +-- Stored_Constraint -- Defined in entities that can have discriminants (concurrent types -- subtypes, record types and subtypes, private types and subtypes, -- limited private types and subtypes and incomplete types). Points -- to an element list containing the expressions for each of the -- stored discriminants for the record (sub)type. --- Stores_Attribute_Old_Prefix (Flag270) +-- Stores_Attribute_Old_Prefix -- Defined in constants, variables, and types which are created during -- expansion in order to save the value of attribute 'Old's prefix. --- Strict_Alignment (Flag145) [implementation base type only] +-- Strict_Alignment [implementation base type only] -- Defined in all type entities. Indicates that the type is by-reference -- or contains an aliased part. This forbids packing a component of this -- type tighter than the alignment and size of the type, as specified by -- RM 13.2(7) modified by AI12-001 as a Binding Interpretation. --- String_Literal_Length (Uint16) +-- String_Literal_Length -- Defined in string literal subtypes (which are created to correspond -- to string literals in the program). Contains the length of the string -- literal. --- String_Literal_Low_Bound (Node18) +-- String_Literal_Low_Bound -- Defined in string literal subtypes (which are created to correspond -- to string literals in the program). Contains an expression whose -- value represents the low bound of the literal. This is a copy of -- the low bound of the applicable index constraint if there is one, -- or a copy of the low bound of the index base type if not. --- Subprograms_For_Type (Elist29) +-- Subprograms_For_Type -- Defined in all types. The list may contain the entities of the default -- initial condition procedure, invariant procedure, and the two versions -- of the predicate function. @@ -4498,14 +4503,14 @@ package Einfo is -- entities rather than an Elist. The Elist allows greater flexibility -- in inheritance of subprograms between views of the same type. --- Subps_Index (Uint24) +-- Subps_Index -- Present in subprogram entries. Set if the subprogram contains nested -- subprograms, or is a subprogram nested within such a subprogram. Holds -- the index in the Exp_Unst.Subps table for the subprogram. Note that -- for the outer level subprogram, this is the starting index in the Subp -- table for the entries for this subprogram. --- Suppress_Elaboration_Warnings (Flag303) +-- Suppress_Elaboration_Warnings -- NOTE: this flag is relevant only for the legacy ABE mechanism and -- should not be used outside of that context. -- @@ -4519,7 +4524,7 @@ package Einfo is -- and it is set on variables when a warning is given to avoid multiple -- elaboration warnings for the same variable. --- Suppress_Initialization (Flag105) +-- Suppress_Initialization -- Defined in all variable, type and subtype entities. If set for a base -- type, then the generation of initialization procedures is suppressed -- for the type. Any other implicit initialization (e.g. from the use of @@ -4531,17 +4536,17 @@ package Einfo is -- we know that no initialization is required. For example, enumeration -- image table entities set it. --- Suppress_Style_Checks (Flag165) +-- Suppress_Style_Checks -- Defined in all entities. Suppresses any style checks specifically -- associated with the given entity if set. --- Suppress_Value_Tracking_On_Call (Flag217) +-- Suppress_Value_Tracking_On_Call -- Defined in all entities. Set in a scope entity if value tracking is to -- be suppressed on any call within the scope. Used when an access to a -- local subprogram is computed, to deal with the possibility that this -- value may be passed around, and if used, may clobber a local variable. --- Task_Body_Procedure (Node25) +-- Task_Body_Procedure -- Defined in task types and subtypes. Points to the entity for the task -- task body procedure (as further described in Exp_Ch9, task bodies are -- expanded into procedures). A convenient function to retrieve this @@ -4550,11 +4555,11 @@ package Einfo is -- The last sentence is odd??? Why not have Task_Body_Procedure go to the -- Underlying_Type of the Root_Type??? --- Thunk_Entity (Node31) +-- Thunk_Entity -- Defined in functions and procedures which have been classified as -- Is_Thunk. Set to the target entity called by the thunk. --- Treat_As_Volatile (Flag41) +-- Treat_As_Volatile -- Defined in all type entities, and also in constants, components and -- variables. Set if this entity is to be treated as volatile for code -- generation purposes. Always set if Is_Volatile is set, but can also @@ -4583,7 +4588,7 @@ package Einfo is -- base type, but may be an expression in the case of scalar type with -- dynamic bounds. --- Underlying_Full_View (Node19) +-- Underlying_Full_View -- Defined in private subtypes that are the completion of other private -- types, or in private types that are derived from private subtypes. If -- the full view of a private type T is derived from another private type @@ -4597,7 +4602,7 @@ package Einfo is -- private completion. If Td is already constrained, then its full view -- can serve directly as the full view of T. --- Underlying_Record_View (Node28) +-- Underlying_Record_View -- Defined in record types. Set for record types that are extensions of -- types with unknown discriminants, and also set for internally built -- underlying record views to reference its original record type. Record @@ -4623,7 +4628,7 @@ package Einfo is -- type is declared in an enclosing package, the attribute will be non- -- trivial only after the full view of the type has been analyzed. --- Universal_Aliasing (Flag216) [implementation base type only] +-- Universal_Aliasing [implementation base type only] -- Defined in all type entities. Set to direct the back-end to avoid -- any optimizations based on type-based alias analysis for this type. -- Indicates that objects of this type can alias objects of any other @@ -4632,64 +4637,64 @@ package Einfo is -- of these objects. In other words, the effect is as though access -- types designating this type were subject to No_Strict_Aliasing. --- Unset_Reference (Node16) +-- Unset_Reference -- Defined in variables and out parameters. This is normally Empty. It -- is set to point to an identifier that represents a reference to the -- entity before any value has been set. Only the first such reference -- is identified. This field is used to generate a warning message if -- necessary (see Sem_Warn.Check_Unset_Reference). --- Used_As_Generic_Actual (Flag222) +-- Used_As_Generic_Actual -- Defined in all entities, set if the entity is used as an argument to -- a generic instantiation. Used to tune certain warning messages, and -- in checking type conformance within an instantiation that involves -- incomplete formal and actual types. --- Uses_Lock_Free (Flag188) +-- Uses_Lock_Free -- Defined in protected type entities. Set to True when the Lock Free -- implementation is used for the protected type. This implementation is -- based on atomic transactions and doesn't require anymore the use of -- Protection object (see System.Tasking.Protected_Objects). --- Uses_Sec_Stack (Flag95) +-- Uses_Sec_Stack -- Defined in scope entities (blocks, entries, entry families, functions, -- loops, and procedures). Set to True when the secondary stack is used -- in this scope and must be released on exit unless flag -- Sec_Stack_Needed_For_Return is set. --- Validated_Object (Node38) +-- Validated_Object -- Defined in variables. Contains the object whose value is captured by -- the variable for validity check purposes. --- Warnings_Off (Flag96) +-- Warnings_Off -- Defined in all entities. Set if a pragma Warnings (Off, entity-name) -- is used to suppress warnings for a given entity. It is also used by -- the compiler in some situations to kill spurious warnings. Note that -- clients should generally not test this flag directly, but instead -- use function Has_Warnings_Off. --- Warnings_Off_Used (Flag236) +-- Warnings_Off_Used -- Defined in all entities. Can only be set if Warnings_Off is set. If -- set indicates that a warning was suppressed by the Warnings_Off flag, -- and Unmodified/Unreferenced would not have suppressed the warning. --- Warnings_Off_Used_Unmodified (Flag237) +-- Warnings_Off_Used_Unmodified -- Defined in all entities. Can only be set if Warnings_Off is set and -- Has_Pragma_Unmodified is not set. If set indicates that a warning was -- suppressed by the Warnings_Off status but that pragma Unmodified -- would also have suppressed the warning. --- Warnings_Off_Used_Unreferenced (Flag238) +-- Warnings_Off_Used_Unreferenced -- Defined in all entities. Can only be set if Warnings_Off is set and -- Has_Pragma_Unreferenced is not set. If set indicates that a warning -- was suppressed by the Warnings_Off status but that pragma Unreferenced -- would also have suppressed the warning. --- Was_Hidden (Flag196) +-- Was_Hidden -- Defined in all entities. Used to save the value of the Is_Hidden -- attribute when the limited-view is installed (Ada 2005: AI-217). --- Wrapped_Entity (Node27) +-- Wrapped_Entity -- Defined in functions and procedures which have been classified as -- Is_Primitive_Wrapper. Set to the entity being wrapper. @@ -4697,8 +4702,6 @@ package Einfo is -- Renaming and Aliasing -- --------------------------- --- ???The following comments are not quite right; see Einfo.Utils. - -- Several entity attributes relate to renaming constructs, and to the use of -- different names to refer to the same entity. The following is a summary of -- these constructs and their prefered uses. @@ -4709,8 +4712,8 @@ package Einfo is -- Renamed_Object -- Alias --- They all overlap because they are supposed to apply to different entity --- kinds. They are semantically related, and have the following intended uses: +-- These are implemented in Einfo.Utils as renamings of the Renamed_Or_Alias +-- field. They are semantically related, and have the following intended uses: -- a) Renamed_Entity applies to entities in renaming declarations that rename -- an entity, so the value of the attribute IS an entity. This applies to @@ -4806,11 +4809,6 @@ package Einfo is -- resolution. Any_Access is also replaced by the context type after -- resolution. --------------------------------- --- Classification of Entities -- --------------------------------- --- ????Some comments here should be retrieved - -------------------------------------------------------- -- Description of Defined Attributes for Entity_Kinds -- -------------------------------------------------------- @@ -4825,116 +4823,116 @@ package Einfo is -- Ekind (Ekind) - -- Chars (Name1) - -- Next_Entity (Node2) - -- Scope (Node3) - -- Homonym (Node4) - -- Etype (Node5) - -- First_Rep_Item (Node6) - -- Freeze_Node (Node7) - -- Prev_Entity (Node36) - -- Associated_Entity (Node37) - - -- Address_Taken (Flag104) - -- Can_Never_Be_Null (Flag38) - -- Checks_May_Be_Suppressed (Flag31) - -- Debug_Info_Off (Flag166) - -- Has_Convention_Pragma (Flag119) - -- Has_Delayed_Aspects (Flag200) - -- Has_Delayed_Freeze (Flag18) - -- Has_Fully_Qualified_Name (Flag173) - -- Has_Gigi_Rep_Item (Flag82) - -- Has_Homonym (Flag56) - -- Has_Pragma_Elaborate_Body (Flag150) - -- Has_Pragma_Inline (Flag157) - -- Has_Pragma_Inline_Always (Flag230) - -- Has_Pragma_No_Inline (Flag201) - -- Has_Pragma_Pure (Flag203) - -- Has_Pragma_Pure_Function (Flag179) - -- Has_Pragma_Thread_Local_Storage (Flag169) - -- Has_Pragma_Unmodified (Flag233) - -- Has_Pragma_Unreferenced (Flag180) - -- Has_Pragma_Unused (Flag294) - -- Has_Private_Declaration (Flag155) - -- Has_Qualified_Name (Flag161) - -- Has_Stream_Size_Clause (Flag184) - -- Has_Unknown_Discriminants (Flag72) - -- Has_Xref_Entry (Flag182) - -- In_Private_Part (Flag45) - -- Is_Ada_2005_Only (Flag185) - -- Is_Ada_2012_Only (Flag199) - -- Is_Bit_Packed_Array (Flag122) (base type only) - -- Is_Aliased (Flag15) - -- Is_Character_Type (Flag63) - -- Is_Checked_Ghost_Entity (Flag277) - -- Is_Child_Unit (Flag73) - -- Is_Compilation_Unit (Flag149) - -- Is_Descendant_Of_Address (Flag223) - -- Is_Discrim_SO_Function (Flag176) - -- Is_Discriminant_Check_Function (Flag264) - -- Is_Dispatch_Table_Entity (Flag234) - -- Is_Dispatching_Operation (Flag6) - -- Is_Entry_Formal (Flag52) - -- Is_Exported (Flag99) - -- Is_First_Subtype (Flag70) - -- Is_Formal_Subprogram (Flag111) - -- Is_Generic_Instance (Flag130) - -- Is_Generic_Type (Flag13) - -- Is_Hidden (Flag57) - -- Is_Hidden_Open_Scope (Flag171) - -- Is_Ignored_Ghost_Entity (Flag278) - -- Is_Immediately_Visible (Flag7) - -- Is_Implementation_Defined (Flag254) - -- Is_Imported (Flag24) - -- Is_Inlined (Flag11) - -- Is_Internal (Flag17) - -- Is_Itype (Flag91) - -- Is_Known_Non_Null (Flag37) - -- Is_Known_Null (Flag204) - -- Is_Known_Valid (Flag170) - -- Is_Limited_Composite (Flag106) - -- Is_Limited_Record (Flag25) - -- Is_Loop_Parameter (Flag307) - -- Is_Obsolescent (Flag153) - -- Is_Package_Body_Entity (Flag160) - -- Is_Packed_Array_Impl_Type (Flag138) - -- Is_Potentially_Use_Visible (Flag9) - -- Is_Preelaborated (Flag59) - -- Is_Primitive_Wrapper (Flag195) - -- Is_Public (Flag10) - -- Is_Pure (Flag44) - -- Is_Remote_Call_Interface (Flag62) - -- Is_Remote_Types (Flag61) - -- Is_Renaming_Of_Object (Flag112) - -- Is_Shared_Passive (Flag60) - -- Is_Statically_Allocated (Flag28) - -- Is_Static_Type (Flag281) - -- Is_Tagged_Type (Flag55) - -- Is_Thunk (Flag225) - -- Is_Trivial_Subprogram (Flag235) - -- Is_Unchecked_Union (Flag117) - -- Is_Unimplemented (Flag284) - -- Is_Visible_Formal (Flag206) - -- Kill_Elaboration_Checks (Flag32) - -- Kill_Range_Checks (Flag33) - -- Low_Bound_Tested (Flag205) - -- Materialize_Entity (Flag168) - -- Needs_Debug_Info (Flag147) - -- Never_Set_In_Source (Flag115) - -- No_Return (Flag113) - -- Overlays_Constant (Flag243) - -- Referenced (Flag156) - -- Referenced_As_LHS (Flag36) - -- Referenced_As_Out_Parameter (Flag227) - -- Suppress_Elaboration_Warnings (Flag303) - -- Suppress_Style_Checks (Flag165) - -- Suppress_Value_Tracking_On_Call (Flag217) - -- Used_As_Generic_Actual (Flag222) - -- Warnings_Off (Flag96) - -- Warnings_Off_Used (Flag236) - -- Warnings_Off_Used_Unmodified (Flag237) - -- Warnings_Off_Used_Unreferenced (Flag238) - -- Was_Hidden (Flag196) + -- Chars + -- Next_Entity + -- Scope + -- Homonym + -- Etype + -- First_Rep_Item + -- Freeze_Node + -- Prev_Entity + -- Associated_Entity + + -- Address_Taken + -- Can_Never_Be_Null + -- Checks_May_Be_Suppressed + -- Debug_Info_Off + -- Has_Convention_Pragma + -- Has_Delayed_Aspects + -- Has_Delayed_Freeze + -- Has_Fully_Qualified_Name + -- Has_Gigi_Rep_Item + -- Has_Homonym + -- Has_Pragma_Elaborate_Body + -- Has_Pragma_Inline + -- Has_Pragma_Inline_Always + -- Has_Pragma_No_Inline + -- Has_Pragma_Pure + -- Has_Pragma_Pure_Function + -- Has_Pragma_Thread_Local_Storage + -- Has_Pragma_Unmodified + -- Has_Pragma_Unreferenced + -- Has_Pragma_Unused + -- Has_Private_Declaration + -- Has_Qualified_Name + -- Has_Stream_Size_Clause + -- Has_Unknown_Discriminants + -- Has_Xref_Entry + -- In_Private_Part + -- Is_Ada_2005_Only + -- Is_Ada_2012_Only + -- Is_Bit_Packed_Array (base type only) + -- Is_Aliased + -- Is_Character_Type + -- Is_Checked_Ghost_Entity + -- Is_Child_Unit + -- Is_Compilation_Unit + -- Is_Descendant_Of_Address + -- Is_Discrim_SO_Function + -- Is_Discriminant_Check_Function + -- Is_Dispatch_Table_Entity + -- Is_Dispatching_Operation + -- Is_Entry_Formal + -- Is_Exported + -- Is_First_Subtype + -- Is_Formal_Subprogram + -- Is_Generic_Instance + -- Is_Generic_Type + -- Is_Hidden + -- Is_Hidden_Open_Scope + -- Is_Ignored_Ghost_Entity + -- Is_Immediately_Visible + -- Is_Implementation_Defined + -- Is_Imported + -- Is_Inlined + -- Is_Internal + -- Is_Itype + -- Is_Known_Non_Null + -- Is_Known_Null + -- Is_Known_Valid + -- Is_Limited_Composite + -- Is_Limited_Record + -- Is_Loop_Parameter + -- Is_Obsolescent + -- Is_Package_Body_Entity + -- Is_Packed_Array_Impl_Type + -- Is_Potentially_Use_Visible + -- Is_Preelaborated + -- Is_Primitive_Wrapper + -- Is_Public + -- Is_Pure + -- Is_Remote_Call_Interface + -- Is_Remote_Types + -- Is_Renaming_Of_Object + -- Is_Shared_Passive + -- Is_Statically_Allocated + -- Is_Static_Type + -- Is_Tagged_Type + -- Is_Thunk + -- Is_Trivial_Subprogram + -- Is_Unchecked_Union + -- Is_Unimplemented + -- Is_Visible_Formal + -- Kill_Elaboration_Checks + -- Kill_Range_Checks + -- Low_Bound_Tested + -- Materialize_Entity + -- Needs_Debug_Info + -- Never_Set_In_Source + -- No_Return + -- Overlays_Constant + -- Referenced + -- Referenced_As_LHS + -- Referenced_As_Out_Parameter + -- Suppress_Elaboration_Warnings + -- Suppress_Style_Checks + -- Suppress_Value_Tracking_On_Call + -- Used_As_Generic_Actual + -- Warnings_Off + -- Warnings_Off_Used + -- Warnings_Off_Used_Unmodified + -- Warnings_Off_Used_Unreferenced + -- Was_Hidden -- Declaration_Node (synth) -- Has_Foreign_Convention (synth) @@ -4949,95 +4947,95 @@ package Einfo is -- types and subtypes. References to this list appear subsequently as -- "(plus type attributes)" for each appropriate Entity_Kind. - -- Associated_Node_For_Itype (Node8) - -- Class_Wide_Type (Node9) - -- Full_View (Node11) - -- Esize (Uint12) - -- RM_Size (Uint13) - -- Alignment (Uint14) - -- Pending_Access_Types (Elist15) - -- Related_Expression (Node24) - -- Current_Use_Clause (Node27) - -- Subprograms_For_Type (Elist29) - -- Derived_Type_Link (Node31) - -- No_Tagged_Streams_Pragma (Node32) - -- Linker_Section_Pragma (Node33) - -- SPARK_Pragma (Node40) - - -- Depends_On_Private (Flag14) - -- Disable_Controlled (Flag253) - -- Discard_Names (Flag88) - -- Finalize_Storage_Only (Flag158) (base type only) - -- From_Limited_With (Flag159) - -- Has_Aliased_Components (Flag135) (base type only) - -- Has_Alignment_Clause (Flag46) - -- Has_Atomic_Components (Flag86) (base type only) - -- Has_Completion_In_Body (Flag71) - -- Has_Complex_Representation (Flag140) (base type only) - -- Has_Constrained_Partial_View (Flag187) - -- Has_Controlled_Component (Flag43) (base type only) - -- Has_Default_Aspect (Flag39) (base type only) - -- Has_Delayed_Rep_Aspects (Flag261) - -- Has_Discriminants (Flag5) - -- Has_Dynamic_Predicate_Aspect (Flag258) - -- Has_Independent_Components (Flag34) (base type only) - -- Has_Inheritable_Invariants (Flag248) (base type only) - -- Has_Inherited_DIC (Flag133) (base type only) - -- Has_Inherited_Invariants (Flag291) (base type only) - -- Has_Non_Standard_Rep (Flag75) (base type only) - -- Has_Object_Size_Clause (Flag172) - -- Has_Own_DIC (Flag3) (base type only) - -- Has_Own_Invariants (Flag232) (base type only) - -- Has_Pragma_Preelab_Init (Flag221) - -- Has_Pragma_Unreferenced_Objects (Flag212) - -- Has_Predicates (Flag250) - -- Has_Primitive_Operations (Flag120) (base type only) - -- Has_Protected (Flag271) (base type only) - -- Has_Size_Clause (Flag29) - -- Has_Specified_Layout (Flag100) (base type only) - -- Has_Specified_Stream_Input (Flag190) - -- Has_Specified_Stream_Output (Flag191) - -- Has_Specified_Stream_Read (Flag192) - -- Has_Specified_Stream_Write (Flag193) - -- Has_Static_Predicate (Flag269) - -- Has_Static_Predicate_Aspect (Flag259) - -- Has_Task (Flag30) (base type only) - -- Has_Timing_Event (Flag289) (base type only) - -- Has_Unchecked_Union (Flag123) (base type only) - -- Has_Volatile_Components (Flag87) (base type only) - -- In_Use (Flag8) - -- Is_Abstract_Type (Flag146) - -- Is_Asynchronous (Flag81) - -- Is_Atomic (Flag85) - -- Is_Constr_Subt_For_U_Nominal (Flag80) - -- Is_Constr_Subt_For_UN_Aliased (Flag141) - -- Is_Controlled_Active (Flag42) (base type only) - -- Is_Eliminated (Flag124) - -- Is_Frozen (Flag4) - -- Is_Generic_Actual_Type (Flag94) - -- Is_Independent (Flag268) - -- Is_Non_Static_Subtype (Flag109) - -- Is_Packed (Flag51) (base type only) - -- Is_Private_Composite (Flag107) - -- Is_RACW_Stub_Type (Flag244) - -- Is_Unsigned_Type (Flag144) - -- Is_Volatile (Flag16) - -- Is_Volatile_Full_Access (Flag285) - -- Itype_Printed (Flag202) (itypes only) - -- Known_To_Have_Preelab_Init (Flag207) - -- May_Inherit_Delayed_Rep_Aspects (Flag262) - -- Must_Be_On_Byte_Boundary (Flag183) - -- Must_Have_Preelab_Init (Flag208) - -- Optimize_Alignment_Space (Flag241) - -- Optimize_Alignment_Time (Flag242) - -- Partial_View_Has_Unknown_Discr (Flag280) - -- Size_Depends_On_Discriminant (Flag177) - -- Size_Known_At_Compile_Time (Flag92) - -- SPARK_Pragma_Inherited (Flag265) - -- Strict_Alignment (Flag145) (base type only) - -- Suppress_Initialization (Flag105) - -- Treat_As_Volatile (Flag41) - -- Universal_Aliasing (Flag216) (impl base type only) + -- Associated_Node_For_Itype + -- Class_Wide_Type + -- Full_View + -- Esize + -- RM_Size + -- Alignment + -- Pending_Access_Types + -- Related_Expression + -- Current_Use_Clause + -- Subprograms_For_Type + -- Derived_Type_Link + -- No_Tagged_Streams_Pragma + -- Linker_Section_Pragma + -- SPARK_Pragma + + -- Depends_On_Private + -- Disable_Controlled + -- Discard_Names + -- Finalize_Storage_Only (base type only) + -- From_Limited_With + -- Has_Aliased_Components (base type only) + -- Has_Alignment_Clause + -- Has_Atomic_Components (base type only) + -- Has_Completion_In_Body + -- Has_Complex_Representation (base type only) + -- Has_Constrained_Partial_View + -- Has_Controlled_Component (base type only) + -- Has_Default_Aspect (base type only) + -- Has_Delayed_Rep_Aspects + -- Has_Discriminants + -- Has_Dynamic_Predicate_Aspect + -- Has_Independent_Components (base type only) + -- Has_Inheritable_Invariants (base type only) + -- Has_Inherited_DIC (base type only) + -- Has_Inherited_Invariants (base type only) + -- Has_Non_Standard_Rep (base type only) + -- Has_Object_Size_Clause + -- Has_Own_DIC (base type only) + -- Has_Own_Invariants (base type only) + -- Has_Pragma_Preelab_Init + -- Has_Pragma_Unreferenced_Objects + -- Has_Predicates + -- Has_Primitive_Operations (base type only) + -- Has_Protected (base type only) + -- Has_Size_Clause + -- Has_Specified_Layout (base type only) + -- Has_Specified_Stream_Input + -- Has_Specified_Stream_Output + -- Has_Specified_Stream_Read + -- Has_Specified_Stream_Write + -- Has_Static_Predicate + -- Has_Static_Predicate_Aspect + -- Has_Task (base type only) + -- Has_Timing_Event (base type only) + -- Has_Unchecked_Union (base type only) + -- Has_Volatile_Components (base type only) + -- In_Use + -- Is_Abstract_Type + -- Is_Asynchronous + -- Is_Atomic + -- Is_Constr_Subt_For_U_Nominal + -- Is_Constr_Subt_For_UN_Aliased + -- Is_Controlled_Active (base type only) + -- Is_Eliminated + -- Is_Frozen + -- Is_Generic_Actual_Type + -- Is_Independent + -- Is_Non_Static_Subtype + -- Is_Packed (base type only) + -- Is_Private_Composite + -- Is_RACW_Stub_Type + -- Is_Unsigned_Type + -- Is_Volatile + -- Is_Volatile_Full_Access + -- Itype_Printed (itypes only) + -- Known_To_Have_Preelab_Init + -- May_Inherit_Delayed_Rep_Aspects + -- Must_Be_On_Byte_Boundary + -- Must_Have_Preelab_Init + -- Optimize_Alignment_Space + -- Optimize_Alignment_Time + -- Partial_View_Has_Unknown_Discr + -- Size_Depends_On_Discriminant + -- Size_Known_At_Compile_Time + -- SPARK_Pragma_Inherited + -- Strict_Alignment (base type only) + -- Suppress_Initialization + -- Treat_As_Volatile + -- Universal_Aliasing (impl base type only) -- Alignment_Clause (synth) -- Base_Type (synth) @@ -5062,22 +5060,21 @@ package Einfo is ------------------------------------------ -- 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 "$$$???". + -- ongoing project, a number of discrepancies were noticed. They are + -- documented in comments, and marked with "$$$". -- E_Abstract_State - -- Refinement_Constituents (Elist8) - -- Part_Of_Constituents (Elist10) - -- Body_References (Elist16) - -- Non_Limited_View (Node19) - -- Encapsulating_State (Node32) - -- SPARK_Pragma (Node40) - -- From_Limited_With (Flag159) - -- Has_Partial_Visible_Refinement (Flag296) - -- Has_Visible_Refinement (Flag263) - -- SPARK_Pragma_Inherited (Flag265) - -- First_Entity $$$??? + -- Refinement_Constituents + -- Part_Of_Constituents + -- Body_References + -- Non_Limited_View + -- Encapsulating_State + -- SPARK_Pragma + -- From_Limited_With + -- Has_Partial_Visible_Refinement + -- Has_Visible_Refinement + -- SPARK_Pragma_Inherited + -- First_Entity $$$ -- Has_Non_Limited_View (synth) -- Has_Non_Null_Visible_Refinement (synth) -- Has_Null_Visible_Refinement (synth) @@ -5088,1092 +5085,1092 @@ package Einfo is -- Partial_Refinement_Constituents (synth) -- E_Access_Protected_Subprogram_Type - -- Equivalent_Type (Node18) - -- Directly_Designated_Type (Node20) - -- Needs_No_Actuals (Flag22) - -- Can_Use_Internal_Rep (Flag229) + -- Equivalent_Type + -- Directly_Designated_Type + -- Needs_No_Actuals + -- Can_Use_Internal_Rep -- (plus type attributes) -- E_Access_Subprogram_Type - -- Equivalent_Type (Node18) (remote types only) - -- Directly_Designated_Type (Node20) - -- Needs_No_Actuals (Flag22) - -- Original_Access_Type (Node28) - -- Can_Use_Internal_Rep (Flag229) - -- Needs_Activation_Record (Flag306) - -- Associated_Storage_Pool $$$??? - -- Interface_Name $$$??? + -- Equivalent_Type (remote types only) + -- Directly_Designated_Type + -- Needs_No_Actuals + -- Original_Access_Type + -- Can_Use_Internal_Rep + -- Needs_Activation_Record + -- 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) - -- Finalization_Master (Node23) (base type only) - -- Storage_Size_Variable (Node26) (base type only) - -- Has_Pragma_Controlled (Flag27) (base type only) - -- Has_Storage_Size_Clause (Flag23) (base type only) - -- Is_Access_Constant (Flag69) - -- Is_Local_Anonymous_Access (Flag194) - -- Is_Pure_Unit_Access_Type (Flag189) - -- No_Pool_Assigned (Flag131) (base type only) - -- No_Strict_Aliasing (Flag136) (base type only) - -- Is_Param_Block_Component_Type (Flag215) (base type only) + -- Direct_Primitive_Operations $$$ type + -- Master_Id + -- Directly_Designated_Type + -- Associated_Storage_Pool (base type only) + -- Finalization_Master (base type only) + -- Storage_Size_Variable (base type only) + -- Has_Pragma_Controlled (base type only) + -- Has_Storage_Size_Clause (base type only) + -- Is_Access_Constant + -- Is_Local_Anonymous_Access + -- Is_Pure_Unit_Access_Type + -- No_Pool_Assigned (base type only) + -- No_Strict_Aliasing (base type only) + -- Is_Param_Block_Component_Type (base type only) -- (plus type attributes) -- E_Access_Attribute_Type - -- Renamed_Entity $$$??? - -- Directly_Designated_Type (Node20) + -- Renamed_Entity $$$ + -- Directly_Designated_Type -- (plus type attributes) -- E_Allocator_Type - -- Directly_Designated_Type (Node20) - -- Associated_Storage_Pool $$$??? + -- Directly_Designated_Type + -- 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) - -- Needs_Activation_Record (Flag306) + -- Interface_Name $$$ E_Anonymous_Access_Subprogram_Type + -- Directly_Designated_Type + -- Storage_Size_Variable is this needed ??? + -- Can_Use_Internal_Rep + -- Needs_Activation_Record -- (plus type attributes) -- E_Anonymous_Access_Type - -- Directly_Designated_Type (Node20) - -- Finalization_Master (Node23) - -- Storage_Size_Variable (Node26) ??? is this needed ??? - -- Associated_Storage_Pool $$$??? + -- Directly_Designated_Type + -- Finalization_Master + -- Storage_Size_Variable 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) - -- Original_Array_Type (Node21) - -- Component_Size (Uint22) (base type only) - -- Packed_Array_Impl_Type (Node23) - -- Related_Array_Object (Node25) - -- Predicated_Parent (Node38) (subtype only) - -- Component_Alignment (special) (base type only) - -- Has_Component_Size_Clause (Flag68) (base type only) - -- Has_Pragma_Pack (Flag121) (impl base type only) - -- Is_Constrained (Flag12) - -- 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) - -- Next_Index (synth) - -- Number_Dimensions (synth) + -- First_Entity $$$ + -- Direct_Primitive_Operations $$$ subtype + -- Renamed_Object $$$ E_Array_Subtype + -- First_Index + -- Default_Aspect_Component_Value (base type only) + -- Component_Type (base type only) + -- Original_Array_Type + -- Component_Size (base type only) + -- Packed_Array_Impl_Type + -- Related_Array_Object + -- Predicated_Parent (subtype only) + -- Component_Alignment (special) (base type only) + -- Has_Component_Size_Clause (base type only) + -- Has_Pragma_Pack (impl base type only) + -- Is_Constrained + -- Reverse_Storage_Order (base type only) + -- SSO_Set_High_By_Default (base type only) + -- SSO_Set_Low_By_Default (base type only) + -- Next_Index (synth) + -- Number_Dimensions (synth) -- (plus type attributes) -- E_Block - -- Renamed_Entity $$$??? - -- Renamed_Object $$$??? - -- Return_Applies_To (Node8) - -- Block_Node (Node11) - -- First_Entity (Node17) - -- Last_Entity (Node20) - -- Scope_Depth_Value (Uint22) - -- Entry_Cancel_Parameter (Node23) - -- Contains_Ignored_Ghost_Code (Flag279) - -- Delay_Cleanups (Flag114) - -- Discard_Names (Flag88) - -- Has_Master_Entity (Flag21) - -- Has_Nested_Block_With_Handler (Flag101) - -- Is_Exception_Handler (Flag286) - -- Sec_Stack_Needed_For_Return (Flag167) - -- Uses_Sec_Stack (Flag95) + -- Renamed_Entity $$$ + -- Renamed_Object $$$ + -- Return_Applies_To + -- Block_Node + -- First_Entity + -- Last_Entity + -- Scope_Depth_Value + -- Entry_Cancel_Parameter + -- Contains_Ignored_Ghost_Code + -- Delay_Cleanups + -- Discard_Names + -- Has_Master_Entity + -- Has_Nested_Block_With_Handler + -- Is_Exception_Handler + -- Sec_Stack_Needed_For_Return + -- Uses_Sec_Stack -- Scope_Depth (synth) -- E_Class_Wide_Type -- E_Class_Wide_Subtype - -- Direct_Primitive_Operations (Elist10) - -- Cloned_Subtype (Node16) (subtype case only) - -- First_Entity (Node17) - -- Equivalent_Type (Node18) (always Empty for type) - -- Non_Limited_View (Node19) - -- 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) + -- Direct_Primitive_Operations + -- Cloned_Subtype (subtype case only) + -- First_Entity + -- Equivalent_Type (always Empty for type) + -- Non_Limited_View + -- Last_Entity + -- SSO_Set_High_By_Default (base type only) + -- SSO_Set_Low_By_Default (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) - -- Component_Bit_Offset (Uint11) - -- Esize (Uint12) - -- Component_Clause (Node13) - -- Normalized_Position (Uint14) - -- DT_Entry_Count (Uint15) - -- Entry_Formal (Node16) - -- Prival (Node17) - -- Renamed_Object (Node18) (always Empty) - -- Discriminant_Checking_Func (Node20) - -- Corresponding_Record_Component (Node21) - -- Original_Record_Component (Node22) - -- DT_Offset_To_Top_Func (Node25) - -- Related_Type (Node27) - -- Has_Biased_Representation (Flag139) - -- Has_Per_Object_Constraint (Flag154) - -- Is_Atomic (Flag85) - -- Is_Independent (Flag268) - -- Is_Return_Object (Flag209) - -- Is_Tag (Flag78) - -- Is_Volatile (Flag16) - -- Is_Volatile_Full_Access (Flag285) - -- Treat_As_Volatile (Flag41) + -- Linker_Section_Pragma $$$ + -- Normalized_First_Bit + -- Current_Value (always Empty) + -- Normalized_Position_Max + -- Component_Bit_Offset + -- Esize + -- Component_Clause + -- Normalized_Position + -- DT_Entry_Count + -- Entry_Formal + -- Prival + -- Renamed_Object (always Empty) + -- Discriminant_Checking_Func + -- Corresponding_Record_Component + -- Original_Record_Component + -- DT_Offset_To_Top_Func + -- Related_Type + -- Has_Biased_Representation + -- Has_Per_Object_Constraint + -- Is_Atomic + -- Is_Independent + -- Is_Return_Object + -- Is_Tag + -- Is_Volatile + -- Is_Volatile_Full_Access + -- Treat_As_Volatile -- Is_Full_Access (synth) -- Next_Component (synth) -- Next_Component_Or_Discriminant (synth) -- E_Constant -- E_Loop_Parameter - -- Current_Value (Node9) (always Empty) - -- Discriminal_Link (Node10) - -- Full_View (Node11) - -- Esize (Uint12) - -- Extra_Accessibility (Node13) (constants only) - -- Alignment (Uint14) - -- 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) - -- Related_Type (Node27) (constants only) - -- Initialization_Statements (Node28) - -- BIP_Initialization_Call (Node29) - -- Last_Aggregate_Assignment (Node30) - -- Activation_Record_Component (Node31) - -- Encapsulating_State (Node32) (constants only) - -- Linker_Section_Pragma (Node33) - -- Contract (Node34) (constants only) - -- SPARK_Pragma (Node40) (constants only) - -- Has_Alignment_Clause (Flag46) - -- Has_Atomic_Components (Flag86) - -- Has_Biased_Representation (Flag139) - -- Has_Completion (Flag26) (constants only) - -- Has_Independent_Components (Flag34) - -- Has_Size_Clause (Flag29) - -- Has_Thunks (Flag228) (constants only) - -- Has_Volatile_Components (Flag87) - -- Is_Atomic (Flag85) - -- Is_Elaboration_Checks_OK_Id (Flag148) (constants only) - -- Is_Elaboration_Warnings_OK_Id (Flag304) (constants only) - -- Is_Eliminated (Flag124) - -- Is_Finalized_Transient (Flag252) - -- Is_Ignored_Transient (Flag295) - -- Is_Independent (Flag268) - -- Is_Return_Object (Flag209) - -- Is_True_Constant (Flag163) - -- Is_Uplevel_Referenced_Entity (Flag283) - -- Is_Volatile (Flag16) - -- Is_Volatile_Full_Access (Flag285) - -- Optimize_Alignment_Space (Flag241) (constants only) - -- Optimize_Alignment_Time (Flag242) (constants only) - -- SPARK_Pragma_Inherited (Flag265) (constants only) - -- Stores_Attribute_Old_Prefix (Flag270) (constants only) - -- Treat_As_Volatile (Flag41) - -- Address_Clause (synth) - -- Alignment_Clause (synth) - -- Is_Elaboration_Target (synth) - -- Is_Full_Access (synth) - -- Size_Clause (synth) + -- Current_Value (always Empty) + -- Discriminal_Link + -- Full_View + -- Esize + -- Extra_Accessibility (constants only) + -- Alignment + -- Status_Flag_Or_Transient_Decl + -- Actual_Subtype + -- Renamed_Object + -- Renamed_Entity $$$ + -- Size_Check_Code (constants only) + -- Prival_Link (privals only) + -- Interface_Name (constants only) + -- Related_Type (constants only) + -- Initialization_Statements + -- BIP_Initialization_Call + -- Last_Aggregate_Assignment + -- Activation_Record_Component + -- Encapsulating_State (constants only) + -- Linker_Section_Pragma + -- Contract (constants only) + -- SPARK_Pragma (constants only) + -- Has_Alignment_Clause + -- Has_Atomic_Components + -- Has_Biased_Representation + -- Has_Completion (constants only) + -- Has_Independent_Components + -- Has_Size_Clause + -- Has_Thunks (constants only) + -- Has_Volatile_Components + -- Is_Atomic + -- Is_Elaboration_Checks_OK_Id (constants only) + -- Is_Elaboration_Warnings_OK_Id (constants only) + -- Is_Eliminated + -- Is_Finalized_Transient + -- Is_Ignored_Transient + -- Is_Independent + -- Is_Return_Object + -- Is_True_Constant + -- Is_Uplevel_Referenced_Entity + -- Is_Volatile + -- Is_Volatile_Full_Access + -- Optimize_Alignment_Space (constants only) + -- Optimize_Alignment_Time (constants only) + -- SPARK_Pragma_Inherited (constants only) + -- Stores_Attribute_Old_Prefix (constants only) + -- Treat_As_Volatile + -- Address_Clause (synth) + -- Alignment_Clause (synth) + -- Is_Elaboration_Target (synth) + -- Is_Full_Access (synth) + -- Size_Clause (synth) -- E_Decimal_Fixed_Point_Type - -- E_Decimal_Fixed_Subtype$$$???no such thing - -- Scale_Value (Uint16) - -- Digits_Value (Uint17) - -- Scalar_Range (Node20) - -- Delta_Value (Ureal18) - -- Small_Value (Ureal21) - -- Static_Real_Or_String_Predicate (Node25) - -- Has_Machine_Radix_Clause (Flag83) - -- Machine_Radix_10 (Flag84) + -- E_Decimal_Fixed_Subtype$$$no such thing + -- Scale_Value + -- Digits_Value + -- Scalar_Range + -- Delta_Value + -- Small_Value + -- Static_Real_Or_String_Predicate + -- Has_Machine_Radix_Clause + -- Machine_Radix_10 -- Aft_Value (synth) -- Type_Low_Bound (synth) -- Type_High_Bound (synth) -- (plus type attributes) -- E_Discriminant - -- Normalized_First_Bit (Uint8) - -- Current_Value (Node9) (always Empty) - -- Normalized_Position_Max (Uint10) - -- Component_Bit_Offset (Uint11) - -- Esize (Uint12) - -- Component_Clause (Node13) - -- Normalized_Position (Uint14) - -- Discriminant_Number (Uint15) - -- Discriminal (Node17) - -- Renamed_Object (Node18) (always Empty) - -- Corresponding_Discriminant (Node19) - -- Discriminant_Default_Value (Node20) - -- Corresponding_Record_Component (Node21) - -- Original_Record_Component (Node22) - -- CR_Discriminant (Node23) - -- Is_Completely_Hidden (Flag103) - -- Is_Return_Object (Flag209) - -- Entry_Formal $$$??? - -- Linker_Section_Pragma $$$??? + -- Normalized_First_Bit + -- Current_Value (always Empty) + -- Normalized_Position_Max + -- Component_Bit_Offset + -- Esize + -- Component_Clause + -- Normalized_Position + -- Discriminant_Number + -- Discriminal + -- Renamed_Object (always Empty) + -- Corresponding_Discriminant + -- Discriminant_Default_Value + -- Corresponding_Record_Component + -- Original_Record_Component + -- CR_Discriminant + -- Is_Completely_Hidden + -- Is_Return_Object + -- Entry_Formal $$$ + -- Linker_Section_Pragma $$$ -- Next_Component_Or_Discriminant (synth) -- Next_Discriminant (synth) -- Next_Stored_Discriminant (synth) -- E_Entry -- E_Entry_Family - -- Protected_Body_Subprogram (Node11) - -- Barrier_Function (Node12) - -- Elaboration_Entity (Node13) - -- Postconditions_Proc (Node14) - -- Entry_Parameters_Type (Node15) - -- First_Entity (Node17) - -- Alias (Node18) (for entry only. Empty) - -- Last_Entity (Node20) - -- Accept_Address (Elist21) - -- Scope_Depth_Value (Uint22) - -- Protection_Object (Node23) (protected kind) - -- Contract_Wrapper (Node25) - -- Extra_Formals (Node28) - -- Contract (Node34) - -- SPARK_Pragma (Node40) (protected kind) - -- Default_Expressions_Processed (Flag108) - -- Entry_Accepted (Flag152) - -- Has_Yield_Aspect (Flag308) - -- Has_Expanded_Contract (Flag240) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- Is_Elaboration_Checks_OK_Id (Flag148) - -- Is_Elaboration_Warnings_OK_Id (Flag304) - -- Is_Entry_Wrapper (Flag297) - -- Needs_No_Actuals (Flag22) - -- 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) - -- First_Formal_With_Extras (synth) - -- Is_Elaboration_Target (synth) - -- Last_Formal (synth) - -- Number_Formals (synth) - -- Scope_Depth (synth) + -- Protected_Body_Subprogram + -- Barrier_Function + -- Elaboration_Entity + -- Postconditions_Proc + -- Entry_Parameters_Type + -- First_Entity + -- Alias (for entry only. Empty) + -- Last_Entity + -- Accept_Address + -- Scope_Depth_Value + -- Protection_Object (protected kind) + -- Contract_Wrapper + -- Extra_Formals + -- Contract + -- SPARK_Pragma (protected kind) + -- Default_Expressions_Processed + -- Entry_Accepted + -- Has_Yield_Aspect + -- Has_Expanded_Contract + -- Ignore_SPARK_Mode_Pragmas + -- Is_Elaboration_Checks_OK_Id + -- Is_Elaboration_Warnings_OK_Id + -- Is_Entry_Wrapper + -- Needs_No_Actuals + -- Sec_Stack_Needed_For_Return + -- SPARK_Pragma_Inherited (protected kind) + -- Uses_Sec_Stack + -- Renamed_Entity $$$ + -- Address_Clause (synth) + -- Entry_Index_Type (synth) + -- First_Formal (synth) + -- First_Formal_With_Extras (synth) + -- Is_Elaboration_Target (synth) + -- Last_Formal (synth) + -- Number_Formals (synth) + -- Scope_Depth (synth) -- E_Entry_Index_Parameter - -- Entry_Index_Constant (Node18) + -- Entry_Index_Constant -- E_Enumeration_Literal - -- Enumeration_Pos (Uint11) - -- Enumeration_Rep (Uint12) - -- Alias (Node18) - -- Enumeration_Rep_Expr (Node22) - -- Interface_Name $$$??? - -- Renamed_Object $$$??? - -- Esize $$$??? - -- Renamed_Entity $$$??? - -- Next_Literal (synth) + -- Enumeration_Pos + -- Enumeration_Rep + -- Alias + -- Enumeration_Rep_Expr + -- 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) - -- Default_Aspect_Value (Node19) (base type only) - -- Scalar_Range (Node20) - -- Lit_Hash (Node21) (root type only) - -- Enum_Pos_To_Rep (Node23) (type only) - -- Static_Discrete_Predicate (List25) - -- Has_Biased_Representation (Flag139) - -- Has_Contiguous_Rep (Flag181) - -- Has_Enumeration_Rep_Clause (Flag66) - -- Has_Pragma_Ordered (Flag198) (base type only) - -- Nonzero_Is_True (Flag162) (base type only) - -- No_Predicate_On_Actual (Flag275) - -- No_Dynamic_Predicate_On_Actual (Flag276) - -- Type_Low_Bound (synth) - -- Type_High_Bound (synth) + -- First_Entity $$$ type + -- Renamed_Object $$$ + -- Lit_Strings (root type only) + -- First_Literal + -- Lit_Indexes (root type only) + -- Default_Aspect_Value (base type only) + -- Scalar_Range + -- Lit_Hash (root type only) + -- Enum_Pos_To_Rep (type only) + -- Static_Discrete_Predicate + -- Has_Biased_Representation + -- Has_Contiguous_Rep + -- Has_Enumeration_Rep_Clause + -- Has_Pragma_Ordered (base type only) + -- Nonzero_Is_True (base type only) + -- No_Predicate_On_Actual + -- No_Dynamic_Predicate_On_Actual + -- Type_Low_Bound (synth) + -- Type_High_Bound (synth) -- (plus type attributes) -- E_Exception - -- Esize (Uint12) - -- Alignment (Uint14) - -- Renamed_Entity (Node18) - -- Register_Exception_Call (Node20) - -- Interface_Name (Node21) - -- Activation_Record_Component (Node31) - -- Discard_Names (Flag88) - -- Is_Raised (Flag224) - -- Renamed_Object $$$??? + -- Esize + -- Alignment + -- Renamed_Entity + -- Register_Exception_Call + -- Interface_Name + -- Activation_Record_Component + -- Discard_Names + -- Is_Raised + -- Renamed_Object $$$ -- E_Exception_Type - -- Equivalent_Type (Node18) + -- Equivalent_Type -- (plus type attributes) -- E_Floating_Point_Type -- E_Floating_Point_Subtype - -- Digits_Value (Uint17) - -- Float_Rep (Uint10) (Float_Rep_Kind) - -- Default_Aspect_Value (Node19) (base type only) - -- Scalar_Range (Node20) - -- Static_Real_Or_String_Predicate (Node25) - -- Machine_Emax_Value (synth) - -- Machine_Emin_Value (synth) - -- Machine_Mantissa_Value (synth) - -- Machine_Radix_Value (synth) - -- Model_Emin_Value (synth) - -- Model_Epsilon_Value (synth) - -- Model_Mantissa_Value (synth) - -- Model_Small_Value (synth) - -- Safe_Emax_Value (synth) - -- Safe_First_Value (synth) - -- Safe_Last_Value (synth) - -- Type_Low_Bound (synth) - -- Type_High_Bound (synth) + -- Digits_Value + -- Float_Rep (Float_Rep_Kind) + -- Default_Aspect_Value (base type only) + -- Scalar_Range + -- Static_Real_Or_String_Predicate + -- Machine_Emax_Value (synth) + -- Machine_Emin_Value (synth) + -- Machine_Mantissa_Value (synth) + -- Machine_Radix_Value (synth) + -- Model_Emin_Value (synth) + -- Model_Epsilon_Value (synth) + -- Model_Mantissa_Value (synth) + -- Model_Small_Value (synth) + -- Safe_Emax_Value (synth) + -- Safe_First_Value (synth) + -- Safe_Last_Value (synth) + -- Type_Low_Bound (synth) + -- Type_High_Bound (synth) -- (plus type attributes) -- E_Function -- E_Generic_Function - -- Mechanism (Uint8) (Mechanism_Type) - -- Renaming_Map (Uint9) - -- Handler_Records (List10) (non-generic case only) - -- Protected_Body_Subprogram (Node11) - -- Next_Inlined_Subprogram (Node12) - -- Elaboration_Entity (Node13) (not implicit /=) - -- Postconditions_Proc (Node14) (non-generic case only) - -- DT_Position (Uint15) - -- DTC_Entity (Node16) - -- 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) - -- Overridden_Operation (Node26) - -- Wrapped_Entity (Node27) (non-generic case only) - -- Extra_Formals (Node28) - -- Anonymous_Masters (Elist29) (non-generic case only) - -- Corresponding_Equality (Node30) (implicit /= only) - -- Thunk_Entity (Node31) (thunk case only) - -- Corresponding_Procedure (Node32) (generate C code only) - -- Linker_Section_Pragma (Node33) - -- Contract (Node34) - -- Import_Pragma (Node35) (non-generic case only) - -- Class_Wide_Clone (Node38) - -- Protected_Subprogram (Node39) (non-generic case only) - -- SPARK_Pragma (Node40) - -- Original_Protected_Subprogram (Node41) - -- Body_Needed_For_SAL (Flag40) - -- Contains_Ignored_Ghost_Code (Flag279) - -- Default_Expressions_Processed (Flag108) - -- Delay_Cleanups (Flag114) - -- Delay_Subprogram_Descriptors (Flag50) - -- Discard_Names (Flag88) - -- Elaboration_Entity_Required (Flag174) - -- Has_Completion (Flag26) - -- Has_Controlling_Result (Flag98) - -- Has_Expanded_Contract (Flag240) (non-generic case only) - -- Has_Master_Entity (Flag21) - -- Has_Missing_Return (Flag142) - -- Has_Nested_Block_With_Handler (Flag101) - -- Has_Nested_Subprogram (Flag282) - -- Has_Out_Or_In_Out_Parameter (Flag110) - -- Has_Recursive_Call (Flag143) - -- Has_Yield_Aspect (Flag308) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- Is_Abstract_Subprogram (Flag19) (non-generic case only) - -- Is_Called (Flag102) (non-generic case only) - -- Is_Constructor (Flag76) - -- Is_CUDA_Kernel (Flag118) (non-generic case only) - -- Is_DIC_Procedure (Flag132) (non-generic case only) - -- Is_Discrim_SO_Function (Flag176) - -- Is_Discriminant_Check_Function (Flag264) - -- Is_Elaboration_Checks_OK_Id (Flag148) - -- Is_Elaboration_Warnings_OK_Id (Flag304) - -- Is_Eliminated (Flag124) - -- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only) - -- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only) - -- Is_Initial_Condition_Procedure (Flag302) (non-generic case only) - -- Is_Inlined_Always (Flag1) (non-generic case only) - -- Is_Instantiated (Flag126) (generic case only) - -- Is_Intrinsic_Subprogram (Flag64) - -- Is_Invariant_Procedure (Flag257) (non-generic case only) - -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only) - -- Is_Partial_Invariant_Procedure (Flag292) (non-generic case only) - -- Is_Predicate_Function (Flag255) (non-generic case only) - -- Is_Predicate_Function_M (Flag256) (non-generic case only) - -- Is_Primitive (Flag218) - -- Is_Primitive_Wrapper (Flag195) (non-generic case only) - -- Is_Private_Descendant (Flag53) - -- Is_Private_Primitive (Flag245) (non-generic case only) - -- Is_Pure (Flag44) - -- Is_Visible_Lib_Unit (Flag116) - -- Needs_No_Actuals (Flag22) - -- Requires_Overriding (Flag213) (non-generic case only) - -- Return_Present (Flag54) - -- Returns_By_Ref (Flag90) - -- Rewritten_For_C (Flag287) (generate C code only) - -- Sec_Stack_Needed_For_Return (Flag167) - -- SPARK_Pragma_Inherited (Flag265) - -- Uses_Sec_Stack (Flag95) - -- Address_Clause (synth) - -- First_Formal (synth) - -- First_Formal_With_Extras (synth) - -- Is_Elaboration_Target (synth) - -- Last_Formal (synth) - -- Number_Formals (synth) - -- Scope_Depth (synth) + -- Mechanism (Mechanism_Type) + -- Renaming_Map + -- Handler_Records (non-generic case only) + -- Protected_Body_Subprogram + -- Next_Inlined_Subprogram + -- Elaboration_Entity (not implicit /=) + -- Postconditions_Proc (non-generic case only) + -- DT_Position + -- DTC_Entity + -- First_Entity + -- Alias (non-generic case only) + -- Renamed_Entity + -- Renamed_Object $$$ + -- Extra_Accessibility_Of_Result (non-generic case only) + -- Last_Entity + -- Interface_Name + -- Scope_Depth_Value + -- Generic_Renamings (for an instance) + -- Inner_Instances (generic case only) + -- Inner_Instances $$$ also E_Function + -- Protection_Object (for concurrent kind) + -- Subps_Index (non-generic case only) + -- Interface_Alias + -- Overridden_Operation + -- Wrapped_Entity (non-generic case only) + -- Extra_Formals + -- Anonymous_Masters (non-generic case only) + -- Corresponding_Equality (implicit /= only) + -- Thunk_Entity (thunk case only) + -- Corresponding_Procedure (generate C code only) + -- Linker_Section_Pragma + -- Contract + -- Import_Pragma (non-generic case only) + -- Class_Wide_Clone + -- Protected_Subprogram (non-generic case only) + -- SPARK_Pragma + -- Original_Protected_Subprogram + -- Body_Needed_For_SAL + -- Contains_Ignored_Ghost_Code + -- Default_Expressions_Processed + -- Delay_Cleanups + -- Delay_Subprogram_Descriptors + -- Discard_Names + -- Elaboration_Entity_Required + -- Has_Completion + -- Has_Controlling_Result + -- Has_Expanded_Contract (non-generic case only) + -- Has_Master_Entity + -- Has_Missing_Return + -- Has_Nested_Block_With_Handler + -- Has_Nested_Subprogram + -- Has_Out_Or_In_Out_Parameter + -- Has_Recursive_Call + -- Has_Yield_Aspect + -- Ignore_SPARK_Mode_Pragmas + -- Is_Abstract_Subprogram (non-generic case only) + -- Is_Called (non-generic case only) + -- Is_Constructor + -- Is_CUDA_Kernel (non-generic case only) + -- Is_DIC_Procedure (non-generic case only) + -- Is_Discrim_SO_Function + -- Is_Discriminant_Check_Function + -- Is_Elaboration_Checks_OK_Id + -- Is_Elaboration_Warnings_OK_Id + -- Is_Eliminated + -- Is_Generic_Actual_Subprogram (non-generic case only) + -- Is_Hidden_Non_Overridden_Subpgm (non-generic case only) + -- Is_Initial_Condition_Procedure (non-generic case only) + -- Is_Inlined_Always (non-generic case only) + -- Is_Instantiated (generic case only) + -- Is_Intrinsic_Subprogram + -- Is_Invariant_Procedure (non-generic case only) + -- Is_Machine_Code_Subprogram (non-generic case only) + -- Is_Partial_Invariant_Procedure (non-generic case only) + -- Is_Predicate_Function (non-generic case only) + -- Is_Predicate_Function_M (non-generic case only) + -- Is_Primitive + -- Is_Primitive_Wrapper (non-generic case only) + -- Is_Private_Descendant + -- Is_Private_Primitive (non-generic case only) + -- Is_Pure + -- Is_Visible_Lib_Unit + -- Needs_No_Actuals + -- Requires_Overriding (non-generic case only) + -- Return_Present + -- Returns_By_Ref + -- Rewritten_For_C (generate C code only) + -- Sec_Stack_Needed_For_Return + -- SPARK_Pragma_Inherited + -- Uses_Sec_Stack + -- Address_Clause (synth) + -- First_Formal (synth) + -- First_Formal_With_Extras (synth) + -- Is_Elaboration_Target (synth) + -- Last_Formal (synth) + -- Number_Formals (synth) + -- 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) - -- Finalization_Master (Node23) (root type only) - -- Storage_Size_Variable (Node26) (base type only) + -- First_Entity $$$ + -- Renamed_Entity $$$ + -- Master_Id + -- Directly_Designated_Type + -- Associated_Storage_Pool (root type only) + -- Finalization_Master (root type only) + -- Storage_Size_Variable (base type only) -- (plus type attributes) -- E_Generic_In_Parameter -- E_Generic_In_Out_Parameter - -- Current_Value (Node9) (always Empty) - -- Entry_Component (Node11) - -- Actual_Subtype (Node17) - -- Renamed_Object (Node18) (always Empty) - -- Default_Value (Node20) - -- Protected_Formal (Node22) - -- Is_Controlling_Formal (Flag97) - -- Is_Return_Object (Flag209) - -- Parameter_Mode (synth) + -- Current_Value (always Empty) + -- Entry_Component + -- Actual_Subtype + -- Renamed_Object (always Empty) + -- Default_Value + -- Protected_Formal + -- Is_Controlling_Formal + -- Is_Return_Object + -- Parameter_Mode (synth) -- E_Incomplete_Type -- E_Incomplete_Subtype - -- Direct_Primitive_Operations (Elist10) - -- Non_Limited_View (Node19) - -- Private_Dependents (Elist18) - -- Discriminant_Constraint (Elist21) - -- Stored_Constraint (Elist23) - -- First_Entity $$$??? - -- Last_Entity $$$??? - -- Has_Non_Limited_View (synth) + -- Direct_Primitive_Operations + -- Non_Limited_View + -- Private_Dependents + -- Discriminant_Constraint + -- Stored_Constraint + -- 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) - -- Entry_Component (Node11) - -- Esize (Uint12) - -- Extra_Accessibility (Node13) - -- Alignment (Uint14) - -- Extra_Formal (Node15) - -- Unset_Reference (Node16) - -- Actual_Subtype (Node17) - -- Renamed_Object (Node18) - -- Spec_Entity (Node19) - -- Default_Value (Node20) - -- Default_Expr_Function (Node21) - -- Protected_Formal (Node22) - -- Extra_Constrained (Node23) - -- Minimum_Accessibility (Node24) - -- Last_Assignment (Node26) (OUT, IN-OUT only) - -- Activation_Record_Component (Node31) - -- Has_Initial_Value (Flag219) - -- Is_Controlling_Formal (Flag97) - -- Is_Only_Out_Parameter (Flag226) - -- Low_Bound_Tested (Flag205) - -- Is_Return_Object (Flag209) - -- Is_Activation_Record (Flag305) - -- Parameter_Mode (synth) + -- Linker_Section_Pragma $$$ + -- Mechanism (Mechanism_Type) + -- Current_Value + -- Discriminal_Link (discriminals only) + -- Entry_Component + -- Esize + -- Extra_Accessibility + -- Alignment + -- Extra_Formal + -- Unset_Reference + -- Actual_Subtype + -- Renamed_Object + -- Spec_Entity + -- Default_Value + -- Default_Expr_Function + -- Protected_Formal + -- Extra_Constrained + -- Minimum_Accessibility + -- Last_Assignment (OUT, IN-OUT only) + -- Activation_Record_Component + -- Has_Initial_Value + -- Is_Controlling_Formal + -- Is_Only_Out_Parameter + -- Low_Bound_Tested + -- Is_Return_Object + -- Is_Activation_Record + -- Parameter_Mode (synth) -- E_Label - -- Renamed_Object $$$??? - -- Renamed_Entity $$$??? - -- Enclosing_Scope (Node18) - -- Reachable (Flag49) + -- Renamed_Object $$$ + -- Renamed_Entity $$$ + -- Enclosing_Scope + -- Reachable -- E_Limited_Private_Type -- E_Limited_Private_Subtype - -- Scalar_Range $$$??? type - -- First_Entity (Node17) - -- Private_Dependents (Elist18) - -- Underlying_Full_View (Node19) - -- Last_Entity (Node20) - -- Discriminant_Constraint (Elist21) - -- Stored_Constraint (Elist23) - -- Has_Completion (Flag26) + -- Scalar_Range $$$ type + -- First_Entity + -- Private_Dependents + -- Underlying_Full_View + -- Last_Entity + -- Discriminant_Constraint + -- Stored_Constraint + -- Has_Completion -- (plus type attributes) -- E_Loop - -- First_Exit_Statement (Node8) - -- Has_Exit (Flag47) - -- Has_Loop_Entry_Attributes (Flag260) - -- Has_Master_Entity (Flag21) - -- Has_Nested_Block_With_Handler (Flag101) - -- Uses_Sec_Stack (Flag95) - -- First_Entity $$$??? - -- Last_Entity $$$??? - -- Renamed_Object $$$??? + -- First_Exit_Statement + -- Has_Exit + -- Has_Loop_Entry_Attributes + -- Has_Master_Entity + -- Has_Nested_Block_With_Handler + -- Uses_Sec_Stack + -- First_Entity $$$ + -- Last_Entity $$$ + -- Renamed_Object $$$ -- E_Modular_Integer_Type -- E_Modular_Integer_Subtype - -- Modulus (Uint17) (base type only) - -- Default_Aspect_Value (Node19) (base type only) - -- Original_Array_Type (Node21) - -- Scalar_Range (Node20) - -- Static_Discrete_Predicate (List25) - -- Non_Binary_Modulus (Flag58) (base type only) - -- Has_Biased_Representation (Flag139) - -- Has_Shift_Operator (Flag267) (base type only) - -- No_Predicate_On_Actual (Flag275) - -- No_Dynamic_Predicate_On_Actual (Flag276) - -- Type_Low_Bound (synth) - -- Type_High_Bound (synth) + -- Modulus (base type only) + -- Default_Aspect_Value (base type only) + -- Original_Array_Type + -- Scalar_Range + -- Static_Discrete_Predicate + -- Non_Binary_Modulus (base type only) + -- Has_Biased_Representation + -- Has_Shift_Operator (base type only) + -- No_Predicate_On_Actual + -- No_Dynamic_Predicate_On_Actual + -- Type_Low_Bound (synth) + -- Type_High_Bound (synth) -- (plus type attributes) -- E_Named_Integer - -- Renamed_Object $$$??? + -- Renamed_Object $$$ -- E_Named_Real -- E_Operator - -- First_Entity (Node17) - -- Alias (Node18) - -- Extra_Accessibility_Of_Result (Node19) - -- Last_Entity (Node20) - -- Subps_Index (Uint24) - -- Overridden_Operation (Node26) - -- Linker_Section_Pragma (Node33) - -- Contract (Node34) - -- Import_Pragma (Node35) - -- SPARK_Pragma (Node40) - -- Default_Expressions_Processed (Flag108) - -- Has_Nested_Subprogram (Flag282) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- Is_Elaboration_Checks_OK_Id (Flag148) - -- Is_Elaboration_Warnings_OK_Id (Flag304) - -- Is_Intrinsic_Subprogram (Flag64) - -- Is_Machine_Code_Subprogram (Flag137) - -- Is_Primitive (Flag218) - -- Is_Pure (Flag44) - -- SPARK_Pragma_Inherited (Flag265) - -- Interface_Name $$$??? - -- Renamed_Entity $$$??? - -- Renamed_Object $$$??? - -- Is_Elaboration_Target (synth) + -- First_Entity + -- Alias + -- Extra_Accessibility_Of_Result + -- Last_Entity + -- Subps_Index + -- Overridden_Operation + -- Linker_Section_Pragma + -- Contract + -- Import_Pragma + -- SPARK_Pragma + -- Default_Expressions_Processed + -- Has_Nested_Subprogram + -- Ignore_SPARK_Mode_Pragmas + -- Is_Elaboration_Checks_OK_Id + -- Is_Elaboration_Warnings_OK_Id + -- Is_Intrinsic_Subprogram + -- Is_Machine_Code_Subprogram + -- Is_Primitive + -- Is_Pure + -- SPARK_Pragma_Inherited + -- 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 ??? -- E_Ordinary_Fixed_Point_Type -- E_Ordinary_Fixed_Point_Subtype - -- Delta_Value (Ureal18) - -- Default_Aspect_Value (Node19) (base type only) - -- Scalar_Range (Node20) - -- Static_Real_Or_String_Predicate (Node25) - -- Small_Value (Ureal21) - -- Has_Small_Clause (Flag67) - -- Aft_Value (synth) - -- Type_Low_Bound (synth) - -- Type_High_Bound (synth) + -- Delta_Value + -- Default_Aspect_Value (base type only) + -- Scalar_Range + -- Static_Real_Or_String_Predicate + -- Small_Value + -- Has_Small_Clause + -- Aft_Value (synth) + -- Type_Low_Bound (synth) + -- Type_High_Bound (synth) -- (plus type attributes) -- E_Package -- E_Generic_Package - -- Dependent_Instances (Elist8) (for an instance) - -- Renaming_Map (Uint9) - -- Handler_Records (List10) (non-generic case only) - -- Generic_Homonym (Node11) (generic case only) - -- Associated_Formal_Package (Node12) - -- Elaboration_Entity (Node13) - -- Related_Instance (Node15) (non-generic case only) - -- 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) - -- Package_Instantiation (Node26) - -- Current_Use_Clause (Node27) - -- Finalizer (Node28) (non-generic case only) - -- Anonymous_Masters (Elist29) (non-generic case only) - -- Contract (Node34) - -- SPARK_Pragma (Node40) - -- SPARK_Aux_Pragma (Node41) - -- Body_Needed_For_Inlining (Flag299) - -- Body_Needed_For_SAL (Flag40) - -- Contains_Ignored_Ghost_Code (Flag279) - -- Delay_Subprogram_Descriptors (Flag50) - -- Discard_Names (Flag88) - -- Elaborate_Body_Desirable (Flag210) (non-generic case only) - -- Elaboration_Entity_Required (Flag174) - -- From_Limited_With (Flag159) - -- Has_All_Calls_Remote (Flag79) - -- Has_Completion (Flag26) - -- Has_Forward_Instantiation (Flag175) - -- Has_Master_Entity (Flag21) - -- Has_RACW (Flag214) (non-generic case only) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- Is_Called (Flag102) (non-generic case only) - -- Is_Elaboration_Checks_OK_Id (Flag148) - -- Is_Elaboration_Warnings_OK_Id (Flag304) - -- Is_Instantiated (Flag126) - -- In_Package_Body (Flag48) - -- Is_Private_Descendant (Flag53) - -- In_Use (Flag8) - -- Is_Visible_Lib_Unit (Flag116) - -- Renamed_In_Spec (Flag231) (non-generic case only) - -- 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) - -- Is_Wrapper_Package (synth) (non-generic case only) - -- Has_Limited_View (synth) (non-generic case only) - -- Scope_Depth (synth) + -- Dependent_Instances (for an instance) + -- Renaming_Map + -- Handler_Records (non-generic case only) + -- Generic_Homonym (generic case only) + -- Associated_Formal_Package + -- Elaboration_Entity + -- Related_Instance (non-generic case only) + -- First_Private_Entity + -- First_Entity + -- Renamed_Entity + -- Renamed_Object $$$ + -- Body_Entity + -- Last_Entity + -- Interface_Name + -- Scope_Depth_Value + -- Generic_Renamings (for an instance) + -- Inner_Instances (generic case only) + -- Inner_Instances $$$ also E_Package + -- Limited_View (non-generic/instance) + -- Incomplete_Actuals (for an instance) + -- Abstract_States + -- Package_Instantiation + -- Current_Use_Clause + -- Finalizer (non-generic case only) + -- Anonymous_Masters (non-generic case only) + -- Contract + -- SPARK_Pragma + -- SPARK_Aux_Pragma + -- Body_Needed_For_Inlining + -- Body_Needed_For_SAL + -- Contains_Ignored_Ghost_Code + -- Delay_Subprogram_Descriptors + -- Discard_Names + -- Elaborate_Body_Desirable (non-generic case only) + -- Elaboration_Entity_Required + -- From_Limited_With + -- Has_All_Calls_Remote + -- Has_Completion + -- Has_Forward_Instantiation + -- Has_Master_Entity + -- Has_RACW (non-generic case only) + -- Ignore_SPARK_Mode_Pragmas + -- Is_Called (non-generic case only) + -- Is_Elaboration_Checks_OK_Id + -- Is_Elaboration_Warnings_OK_Id + -- Is_Instantiated + -- In_Package_Body + -- Is_Private_Descendant + -- In_Use + -- Is_Visible_Lib_Unit + -- Renamed_In_Spec (non-generic case only) + -- SPARK_Aux_Pragma_Inherited + -- SPARK_Pragma_Inherited + -- Static_Elaboration_Desired (non-generic case only) + -- Renamed_Object $$$ + -- Has_Non_Null_Abstract_State (synth) + -- Has_Null_Abstract_State (synth) + -- Is_Elaboration_Target (synth) + -- Is_Wrapper_Package (synth) (non-generic case only) + -- Has_Limited_View (synth) (non-generic case only) + -- Scope_Depth (synth) -- E_Package_Body - -- Handler_Records (List10) (non-generic case only) - -- Related_Instance (Node15) (non-generic case only) - -- First_Entity (Node17) - -- Spec_Entity (Node19) - -- Last_Entity (Node20) - -- Scope_Depth_Value (Uint22) - -- Finalizer (Node28) (non-generic case only) - -- Contract (Node34) - -- SPARK_Pragma (Node40) - -- SPARK_Aux_Pragma (Node41) - -- Contains_Ignored_Ghost_Code (Flag279) - -- Delay_Subprogram_Descriptors (Flag50) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- SPARK_Aux_Pragma_Inherited (Flag266) - -- SPARK_Pragma_Inherited (Flag265) - -- Renamed_Entity $$$??? - -- Scope_Depth (synth) + -- Handler_Records (non-generic case only) + -- Related_Instance (non-generic case only) + -- First_Entity + -- Spec_Entity + -- Last_Entity + -- Scope_Depth_Value + -- Finalizer (non-generic case only) + -- Contract + -- SPARK_Pragma + -- SPARK_Aux_Pragma + -- Contains_Ignored_Ghost_Code + -- Delay_Subprogram_Descriptors + -- Ignore_SPARK_Mode_Pragmas + -- SPARK_Aux_Pragma_Inherited + -- SPARK_Pragma_Inherited + -- Renamed_Entity $$$ + -- Scope_Depth (synth) -- E_Private_Type -- E_Private_Subtype - -- Scalar_Range $$$??? type - -- Direct_Primitive_Operations (Elist10) - -- First_Entity (Node17) - -- Private_Dependents (Elist18) - -- Underlying_Full_View (Node19) - -- Last_Entity (Node20) - -- Discriminant_Constraint (Elist21) - -- Stored_Constraint (Elist23) - -- Has_Completion (Flag26) - -- Is_Controlled_Active (Flag42) (base type only) - -- $$$???above in (plus type attributes) + -- Scalar_Range $$$ type + -- Direct_Primitive_Operations + -- First_Entity + -- Private_Dependents + -- Underlying_Full_View + -- Last_Entity + -- Discriminant_Constraint + -- Stored_Constraint + -- Has_Completion + -- Is_Controlled_Active (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) - -- Next_Inlined_Subprogram (Node12) - -- Elaboration_Entity (Node13) - -- Postconditions_Proc (Node14) (non-generic case only) - -- DT_Position (Uint15) - -- DTC_Entity (Node16) - -- 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) - -- Overridden_Operation (Node26) (never for init proc) - -- Wrapped_Entity (Node27) (non-generic case only) - -- Extra_Formals (Node28) - -- Anonymous_Masters (Elist29) (non-generic case only) - -- Static_Initialization (Node30) (init_proc only) - -- Thunk_Entity (Node31) (thunk case only) - -- Corresponding_Function (Node32) (generate C code only) - -- Linker_Section_Pragma (Node33) - -- Contract (Node34) - -- Import_Pragma (Node35) (non-generic case only) - -- Class_Wide_Clone (Node38) - -- Protected_Subprogram (Node39) (non-generic case only) - -- SPARK_Pragma (Node40) - -- Original_Protected_Subprogram (Node41) - -- Body_Needed_For_SAL (Flag40) - -- Contains_Ignored_Ghost_Code (Flag279) - -- Delay_Cleanups (Flag114)$$$???Dup below - -- Discard_Names (Flag88)$$$???Dup below - -- Elaboration_Entity_Required (Flag174) - -- Default_Expressions_Processed (Flag108) - -- Delay_Cleanups (Flag114) - -- Delay_Subprogram_Descriptors (Flag50) - -- Discard_Names (Flag88) - -- Has_Completion (Flag26) - -- Has_Expanded_Contract (Flag240) (non-generic case only) - -- Has_Master_Entity (Flag21) - -- Has_Nested_Block_With_Handler (Flag101) - -- Has_Nested_Subprogram (Flag282) - -- Has_Yield_Aspect (Flag308) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- Is_Abstract_Subprogram (Flag19) (non-generic case only) - -- Is_Asynchronous (Flag81) - -- Is_Called (Flag102) (non-generic case only) - -- Is_Constructor (Flag76) - -- Is_CUDA_Kernel (Flag118) - -- Is_DIC_Procedure (Flag132) (non-generic case only) - -- Is_Elaboration_Checks_OK_Id (Flag148) - -- Is_Elaboration_Warnings_OK_Id (Flag304) - -- Is_Eliminated (Flag124) - -- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only) - -- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only) - -- Is_Initial_Condition_Procedure (Flag302) (non-generic case only) - -- Is_Inlined_Always (Flag1) (non-generic case only) - -- Is_Instantiated (Flag126) (generic case only) - -- Is_Interrupt_Handler (Flag89) - -- Is_Intrinsic_Subprogram (Flag64) - -- Is_Invariant_Procedure (Flag257) (non-generic case only) - -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only) - -- Is_Null_Init_Proc (Flag178) - -- Is_Partial_DIC_Procedure (synth) (non-generic case only) - -- Is_Partial_Invariant_Procedure (Flag292) (non-generic case only) - -- Is_Predicate_Function (Flag255) (non-generic case only) - -- Is_Predicate_Function_M (Flag256) (non-generic case only) - -- Is_Primitive (Flag218) - -- Is_Primitive_Wrapper (Flag195) (non-generic case only) - -- Is_Private_Descendant (Flag53) - -- Is_Private_Primitive (Flag245) (non-generic case only) - -- Is_Pure (Flag44) - -- Is_Valued_Procedure (Flag127) - -- Is_Visible_Lib_Unit (Flag116) - -- Needs_No_Actuals (Flag22) - -- No_Return (Flag113) - -- 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) - -- Is_Elaboration_Target (synth) - -- Is_Finalizer (synth) - -- Last_Formal (synth) - -- Number_Formals (synth) + -- Associated_Node_For_Itype $$$ E_Procedure + -- Renaming_Map + -- Handler_Records (non-generic case only) + -- Protected_Body_Subprogram + -- Next_Inlined_Subprogram + -- Elaboration_Entity + -- Postconditions_Proc (non-generic case only) + -- DT_Position + -- DTC_Entity + -- First_Entity + -- Alias (non-generic case only) + -- Renamed_Entity + -- Renamed_Object $$$ + -- Receiving_Entry (non-generic case only) + -- Last_Entity + -- Interface_Name + -- Scope_Depth_Value + -- Generic_Renamings (for an instance) + -- Inner_Instances (generic case only) + -- Inner_Instances $$$ also E_Procedure + -- Protection_Object (for concurrent kind) + -- Subps_Index (non-generic case only) + -- Interface_Alias + -- Overridden_Operation (never for init proc) + -- Wrapped_Entity (non-generic case only) + -- Extra_Formals + -- Anonymous_Masters (non-generic case only) + -- Static_Initialization (init_proc only) + -- Thunk_Entity (thunk case only) + -- Corresponding_Function (generate C code only) + -- Linker_Section_Pragma + -- Contract + -- Import_Pragma (non-generic case only) + -- Class_Wide_Clone + -- Protected_Subprogram (non-generic case only) + -- SPARK_Pragma + -- Original_Protected_Subprogram + -- Body_Needed_For_SAL + -- Contains_Ignored_Ghost_Code + -- Delay_Cleanups $$$Dup below + -- Discard_Names $$$Dup below + -- Elaboration_Entity_Required + -- Default_Expressions_Processed + -- Delay_Cleanups + -- Delay_Subprogram_Descriptors + -- Discard_Names + -- Has_Completion + -- Has_Expanded_Contract (non-generic case only) + -- Has_Master_Entity + -- Has_Nested_Block_With_Handler + -- Has_Nested_Subprogram + -- Has_Yield_Aspect + -- Ignore_SPARK_Mode_Pragmas + -- Is_Abstract_Subprogram (non-generic case only) + -- Is_Asynchronous + -- Is_Called (non-generic case only) + -- Is_Constructor + -- Is_CUDA_Kernel + -- Is_DIC_Procedure (non-generic case only) + -- Is_Elaboration_Checks_OK_Id + -- Is_Elaboration_Warnings_OK_Id + -- Is_Eliminated + -- Is_Generic_Actual_Subprogram (non-generic case only) + -- Is_Hidden_Non_Overridden_Subpgm (non-generic case only) + -- Is_Initial_Condition_Procedure (non-generic case only) + -- Is_Inlined_Always (non-generic case only) + -- Is_Instantiated (generic case only) + -- Is_Interrupt_Handler + -- Is_Intrinsic_Subprogram + -- Is_Invariant_Procedure (non-generic case only) + -- Is_Machine_Code_Subprogram (non-generic case only) + -- Is_Null_Init_Proc + -- Is_Partial_DIC_Procedure (synth) (non-generic case only) + -- Is_Partial_Invariant_Procedure (non-generic case only) + -- Is_Predicate_Function (non-generic case only) + -- Is_Predicate_Function_M (non-generic case only) + -- Is_Primitive + -- Is_Primitive_Wrapper (non-generic case only) + -- Is_Private_Descendant + -- Is_Private_Primitive (non-generic case only) + -- Is_Pure + -- Is_Valued_Procedure + -- Is_Visible_Lib_Unit + -- Needs_No_Actuals + -- No_Return + -- Requires_Overriding (non-generic case only) + -- Sec_Stack_Needed_For_Return + -- SPARK_Pragma_Inherited + -- Entry_Parameters_Type $$$ + -- Address_Clause (synth) + -- First_Formal (synth) + -- First_Formal_With_Extras (synth) + -- Is_Elaboration_Target (synth) + -- Is_Finalizer (synth) + -- Last_Formal (synth) + -- Number_Formals (synth) -- E_Protected_Body - -- SPARK_Pragma (Node40) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- SPARK_Pragma_Inherited (Flag265) + -- SPARK_Pragma + -- Ignore_SPARK_Mode_Pragmas + -- SPARK_Pragma_Inherited -- (any others??? First/Last Entity, Scope_Depth???) - -- E_Protected_Object$$$???No such thing + -- E_Protected_Object$$$No such thing -- E_Protected_Type -- E_Protected_Subtype - -- Direct_Primitive_Operations (Elist10) - -- First_Private_Entity (Node16) - -- First_Entity (Node17) - -- Corresponding_Record_Type (Node18) - -- Entry_Bodies_Array (Node19) - -- Last_Entity (Node20) - -- Discriminant_Constraint (Elist21) - -- Scope_Depth_Value (Uint22) - -- Stored_Constraint (Elist23) - -- Anonymous_Object (Node30) - -- Contract (Node34) - -- Entry_Max_Queue_Lengths_Array (Node35) - -- SPARK_Aux_Pragma (Node41) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- SPARK_Aux_Pragma_Inherited (Flag266) - -- Uses_Lock_Free (Flag188) - -- First_Component (synth) - -- First_Component_Or_Discriminant (synth) - -- Has_Entries (synth) - -- Has_Interrupt_Handler (synth) - -- Number_Entries (synth) - -- Scope_Depth (synth) + -- Direct_Primitive_Operations + -- First_Private_Entity + -- First_Entity + -- Corresponding_Record_Type + -- Entry_Bodies_Array + -- Last_Entity + -- Discriminant_Constraint + -- Scope_Depth_Value + -- Stored_Constraint + -- Anonymous_Object + -- Contract + -- Entry_Max_Queue_Lengths_Array + -- SPARK_Aux_Pragma + -- Ignore_SPARK_Mode_Pragmas + -- SPARK_Aux_Pragma_Inherited + -- Uses_Lock_Free + -- First_Component (synth) + -- First_Component_Or_Discriminant (synth) + -- Has_Entries (synth) + -- Has_Interrupt_Handler (synth) + -- Number_Entries (synth) + -- Scope_Depth (synth) -- (plus type attributes) -- 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) - -- First_Entity (Node17) - -- Corresponding_Concurrent_Type (Node18) - -- Parent_Subtype (Node19) (base type only) - -- Last_Entity (Node20) - -- Discriminant_Constraint (Elist21) - -- Corresponding_Remote_Type (Node22) - -- Stored_Constraint (Elist23) - -- Interfaces (Elist25) - -- Dispatch_Table_Wrappers (Elist26) (base type only) - -- Underlying_Record_View (Node28) (base type only) - -- Access_Disp_Table_Elab_Flag (Node30) (base type only) - -- Predicated_Parent (Node38) (subtype only) - -- Component_Alignment (special) (base type only) - -- C_Pass_By_Copy (Flag125) (base type only) - -- Has_Dispatch_Table (Flag220) (base tagged type only) - -- Has_Pragma_Pack (Flag121) (impl base type only) - -- Has_Private_Ancestor (Flag151) - -- Has_Private_Extension (Flag300) - -- Has_Record_Rep_Clause (Flag65) (base type only) - -- Has_Static_Discriminants (Flag211) (subtype only) - -- Is_Class_Wide_Equivalent_Type (Flag35) - -- 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_Bit_Order (Flag164) (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) - -- First_Component (synth) - -- First_Component_Or_Discriminant (synth) + -- Renamed_Entity $$$ type + -- Interface_Name $$$ type + -- Direct_Primitive_Operations + -- Access_Disp_Table (base type only) + -- Cloned_Subtype (subtype case only) + -- First_Entity + -- Corresponding_Concurrent_Type + -- Parent_Subtype (base type only) + -- Last_Entity + -- Discriminant_Constraint + -- Corresponding_Remote_Type + -- Stored_Constraint + -- Interfaces + -- Dispatch_Table_Wrappers (base type only) + -- Underlying_Record_View (base type only) + -- Access_Disp_Table_Elab_Flag (base type only) + -- Predicated_Parent (subtype only) + -- Component_Alignment (special) (base type only) + -- C_Pass_By_Copy (base type only) + -- Has_Dispatch_Table (base tagged type only) + -- Has_Pragma_Pack (impl base type only) + -- Has_Private_Ancestor + -- Has_Private_Extension + -- Has_Record_Rep_Clause (base type only) + -- Has_Static_Discriminants (subtype only) + -- Is_Class_Wide_Equivalent_Type + -- Is_Concurrent_Record_Type + -- Is_Constrained + -- Is_Controlled_Active (base type only) + -- $$$above in (plus type attributes) + -- Is_Interface + -- Is_Limited_Interface + -- No_Reordering (base type only) + -- Reverse_Bit_Order (base type only) + -- Reverse_Storage_Order (base type only) + -- SSO_Set_High_By_Default (base type only) + -- SSO_Set_Low_By_Default (base type only) + -- First_Component (synth) + -- First_Component_Or_Discriminant (synth) -- (plus type attributes) -- 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) - -- Underlying_Full_View (Node19) - -- Last_Entity (Node20) - -- 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) - -- Has_Private_Extension (Flag300) - -- Has_Record_Rep_Clause (Flag65) (base type 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) - -- Reverse_Bit_Order (Flag164) (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) + -- Corresponding_Remote_Type $$$ E_Record_Subtype_With_Private + -- Direct_Primitive_Operations + -- First_Entity + -- Private_Dependents + -- Underlying_Full_View + -- Last_Entity + -- Discriminant_Constraint + -- Stored_Constraint + -- Interfaces + -- Underlying_Record_View $$$ (base type only) + -- Predicated_Parent (subtype only) + -- Has_Completion + -- Has_Private_Ancestor + -- Has_Private_Extension + -- Has_Record_Rep_Clause (base type only) + -- Is_Concurrent_Record_Type + -- Is_Constrained + -- Is_Controlled_Active (base type only) + -- $$$above in (plus type attributes) + -- Is_Interface + -- Is_Limited_Interface + -- No_Reordering (base type only) + -- Reverse_Bit_Order (base type only) + -- Reverse_Storage_Order (base type only) + -- SSO_Set_High_By_Default (base type only) + -- SSO_Set_Low_By_Default (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 $$$??? + -- Return_Applies_To + -- 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) - -- Has_Biased_Representation (Flag139) - -- Has_Shift_Operator (Flag267) (base type only) - -- No_Predicate_On_Actual (Flag275) - -- No_Dynamic_Predicate_On_Actual (Flag276) - -- Type_Low_Bound (synth) - -- Type_High_Bound (synth) + -- Renamed_Object $$$ subtype + -- Interface_Name $$$ subtype + -- Direct_Primitive_Operations $$$ type + -- First_Entity $$$ + -- Default_Aspect_Value (base type only) + -- Scalar_Range + -- Static_Discrete_Predicate + -- Has_Biased_Representation + -- Has_Shift_Operator (base type only) + -- No_Predicate_On_Actual + -- No_Dynamic_Predicate_On_Actual + -- Type_Low_Bound (synth) + -- Type_High_Bound (synth) -- (plus type attributes) -- E_String_Literal_Subtype - -- String_Literal_Length (Uint16) - -- First_Index (Node17) (always Empty) - -- String_Literal_Low_Bound (Node18) - -- Packed_Array_Impl_Type (Node23) + -- String_Literal_Length + -- First_Index (always Empty) + -- String_Literal_Low_Bound + -- Packed_Array_Impl_Type -- (plus type attributes) -- E_Subprogram_Body - -- Mechanism (Uint8) - -- First_Entity (Node17) - -- Corresponding_Protected_Entry (Node18) - -- Last_Entity (Node20) - -- Scope_Depth_Value (Uint22) - -- Extra_Formals (Node28) - -- Anonymous_Masters (Elist29) - -- Contract (Node34) - -- SPARK_Pragma (Node40) - -- Contains_Ignored_Ghost_Code (Flag279) - -- SPARK_Pragma_Inherited (Flag265) - -- Interface_Name $$$??? - -- Renamed_Entity $$$??? - -- Scope_Depth (synth) + -- Mechanism + -- First_Entity + -- Corresponding_Protected_Entry + -- Last_Entity + -- Scope_Depth_Value + -- Extra_Formals + -- Anonymous_Masters + -- Contract + -- SPARK_Pragma + -- Contains_Ignored_Ghost_Code + -- SPARK_Pragma_Inherited + -- Interface_Name $$$ + -- Renamed_Entity $$$ + -- Scope_Depth (synth) -- E_Subprogram_Type - -- Extra_Accessibility_Of_Result (Node19) - -- Directly_Designated_Type (Node20) - -- Extra_Formals (Node28) - -- Access_Subprogram_Wrapper (Node41) - -- First_Formal (synth) - -- First_Formal_With_Extras (synth) - -- Last_Formal (synth) - -- Number_Formals (synth) - -- Returns_By_Ref (Flag90) - -- First_Entity $$$??? - -- Last_Entity $$$??? - -- Interface_Name $$$??? + -- Extra_Accessibility_Of_Result + -- Directly_Designated_Type + -- Extra_Formals + -- Access_Subprogram_Wrapper + -- First_Formal (synth) + -- First_Formal_With_Extras (synth) + -- Last_Formal (synth) + -- Number_Formals (synth) + -- Returns_By_Ref + -- First_Entity $$$ + -- Last_Entity $$$ + -- Interface_Name $$$ -- (plus type attributes) -- E_Task_Body - -- Contract (Node34) - -- SPARK_Pragma (Node40) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- SPARK_Pragma_Inherited (Flag265) - -- First_Entity $$$??? + -- Contract + -- SPARK_Pragma + -- Ignore_SPARK_Mode_Pragmas + -- SPARK_Pragma_Inherited + -- First_Entity $$$ -- (any others??? First/Last Entity, Scope_Depth???) -- E_Task_Type -- E_Task_Subtype - -- Direct_Primitive_Operations (Elist10) - -- First_Private_Entity (Node16) - -- First_Entity (Node17) - -- Corresponding_Record_Type (Node18) - -- Last_Entity (Node20) - -- Discriminant_Constraint (Elist21) - -- Scope_Depth_Value (Uint22) - -- Stored_Constraint (Elist23) - -- Task_Body_Procedure (Node25) - -- Storage_Size_Variable (Node26) (base type only) - -- Relative_Deadline_Variable (Node28) (base type only) - -- Anonymous_Object (Node30) - -- Contract (Node34) - -- SPARK_Aux_Pragma (Node41) - -- Delay_Cleanups (Flag114) - -- Has_Master_Entity (Flag21) - -- Has_Storage_Size_Clause (Flag23) (base type only) - -- Ignore_SPARK_Mode_Pragmas (Flag301) - -- Is_Elaboration_Checks_OK_Id (Flag148) - -- Is_Elaboration_Warnings_OK_Id (Flag304) - -- SPARK_Aux_Pragma_Inherited (Flag266) - -- First_Component (synth) - -- First_Component_Or_Discriminant (synth) - -- Has_Entries (synth) - -- Is_Elaboration_Target (synth) - -- Number_Entries (synth) - -- Scope_Depth (synth) + -- Direct_Primitive_Operations + -- First_Private_Entity + -- First_Entity + -- Corresponding_Record_Type + -- Last_Entity + -- Discriminant_Constraint + -- Scope_Depth_Value + -- Stored_Constraint + -- Task_Body_Procedure + -- Storage_Size_Variable (base type only) + -- Relative_Deadline_Variable (base type only) + -- Anonymous_Object + -- Contract + -- SPARK_Aux_Pragma + -- Delay_Cleanups + -- Has_Master_Entity + -- Has_Storage_Size_Clause (base type only) + -- Ignore_SPARK_Mode_Pragmas + -- Is_Elaboration_Checks_OK_Id + -- Is_Elaboration_Warnings_OK_Id + -- SPARK_Aux_Pragma_Inherited + -- First_Component (synth) + -- First_Component_Or_Discriminant (synth) + -- Has_Entries (synth) + -- Is_Elaboration_Target (synth) + -- Number_Entries (synth) + -- Scope_Depth (synth) -- (plus type attributes) -- E_Variable - -- Hiding_Loop_Variable (Node8) - -- Current_Value (Node9) - -- Part_Of_Constituents (Elist10) - -- Part_Of_References (Elist11) - -- Esize (Uint12) - -- Extra_Accessibility (Node13) - -- Alignment (Uint14) - -- Status_Flag_Or_Transient_Decl (Node15) (transient object only) - -- Unset_Reference (Node16) - -- Actual_Subtype (Node17) - -- Renamed_Object (Node18) - -- Renamed_Entity $$$??? - -- Discriminal_Link $$$??? - -- Size_Check_Code (Node19) - -- Prival_Link (Node20) - -- Interface_Name (Node21) - -- Shared_Var_Procs_Instance (Node22) - -- Extra_Constrained (Node23) - -- Related_Expression (Node24) - -- Debug_Renaming_Link (Node25) - -- Last_Assignment (Node26) - -- Related_Type (Node27) - -- Initialization_Statements (Node28) - -- BIP_Initialization_Call (Node29) - -- Last_Aggregate_Assignment (Node30) - -- Activation_Record_Component (Node31) - -- Encapsulating_State (Node32) - -- Linker_Section_Pragma (Node33) - -- Contract (Node34) - -- Anonymous_Designated_Type (Node35) - -- Validated_Object (Node38) - -- SPARK_Pragma (Node40) - -- Has_Alignment_Clause (Flag46) - -- Has_Atomic_Components (Flag86) - -- Has_Biased_Representation (Flag139) - -- Has_Independent_Components (Flag34) - -- Has_Initial_Value (Flag219) - -- Has_Size_Clause (Flag29) - -- Has_Volatile_Components (Flag87) - -- Is_Atomic (Flag85) - -- Is_Elaboration_Checks_OK_Id (Flag148) - -- Is_Elaboration_Warnings_OK_Id (Flag304) - -- Is_Eliminated (Flag124) - -- Is_Finalized_Transient (Flag252) - -- Is_Ignored_Transient (Flag295) - -- Is_Independent (Flag268) - -- Is_Return_Object (Flag209) - -- Is_Safe_To_Reevaluate (Flag249) - -- Is_Shared_Passive (Flag60) - -- Is_True_Constant (Flag163) - -- Is_Uplevel_Referenced_Entity (Flag283) - -- Is_Volatile (Flag16) - -- Is_Volatile_Full_Access (Flag285) - -- OK_To_Rename (Flag247) - -- Optimize_Alignment_Space (Flag241) - -- Optimize_Alignment_Time (Flag242) - -- SPARK_Pragma_Inherited (Flag265) - -- Suppress_Initialization (Flag105) - -- Treat_As_Volatile (Flag41) - -- Address_Clause (synth) - -- Alignment_Clause (synth) - -- Is_Elaboration_Target (synth) - -- Is_Full_Access (synth) - -- Size_Clause (synth) + -- Hiding_Loop_Variable + -- Current_Value + -- Part_Of_Constituents + -- Part_Of_References + -- Esize + -- Extra_Accessibility + -- Alignment + -- Status_Flag_Or_Transient_Decl (transient object only) + -- Unset_Reference + -- Actual_Subtype + -- Renamed_Object + -- Renamed_Entity $$$ + -- Discriminal_Link $$$ + -- Size_Check_Code + -- Prival_Link + -- Interface_Name + -- Shared_Var_Procs_Instance + -- Extra_Constrained + -- Related_Expression + -- Debug_Renaming_Link + -- Last_Assignment + -- Related_Type + -- Initialization_Statements + -- BIP_Initialization_Call + -- Last_Aggregate_Assignment + -- Activation_Record_Component + -- Encapsulating_State + -- Linker_Section_Pragma + -- Contract + -- Anonymous_Designated_Type + -- Validated_Object + -- SPARK_Pragma + -- Has_Alignment_Clause + -- Has_Atomic_Components + -- Has_Biased_Representation + -- Has_Independent_Components + -- Has_Initial_Value + -- Has_Size_Clause + -- Has_Volatile_Components + -- Is_Atomic + -- Is_Elaboration_Checks_OK_Id + -- Is_Elaboration_Warnings_OK_Id + -- Is_Eliminated + -- Is_Finalized_Transient + -- Is_Ignored_Transient + -- Is_Independent + -- Is_Return_Object + -- Is_Safe_To_Reevaluate + -- Is_Shared_Passive + -- Is_True_Constant + -- Is_Uplevel_Referenced_Entity + -- Is_Volatile + -- Is_Volatile_Full_Access + -- OK_To_Rename + -- Optimize_Alignment_Space + -- Optimize_Alignment_Time + -- SPARK_Pragma_Inherited + -- Suppress_Initialization + -- Treat_As_Volatile + -- Address_Clause (synth) + -- Alignment_Clause (synth) + -- Is_Elaboration_Target (synth) + -- Is_Full_Access (synth) + -- Size_Clause (synth) -- E_Void -- Since E_Void is the initial Ekind value of an entity when it is first @@ -6188,26 +6185,26 @@ package Einfo is -- type checking, since there is no assurance that the eventual Ekind -- 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 ??? + -- weak. -- - -- ???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 $$$??? + -- The 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 -- @@ -6376,14 +6373,4 @@ package Einfo is -- example), the expansion mechanism uses the placeholder of the component -- to correct the Entity and Etype of the reference. - ---------------------------------- - -- Inline Pragmas for functions -- - ---------------------------------- - - -- Note that these inline pragmas are referenced by the XEINFO utility - -- 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. - -- ???? - end Einfo; diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 46531bf7f8e..631773738cf 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -658,10 +658,6 @@ 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); diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index c26b25e742f..9c3bf349621 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -23,11 +23,21 @@ -- -- ------------------------------------------------------------------------------ +with Gen_IL.Types; + 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. + -- (declared below) plus the special null value No_Field. See the spec of + -- Gen_IL.Gen for how to modify this. (Of course, in Ada we have to define + -- this backwards from the above conceptual description.) + + -- Note that there are various subranges of this type declared below, + -- which might need to be kept in sync when modifying this. + + -- Be sure to put new fields in the appropriate subrange (Field_Enum, + -- Node_Header_Field, Node_Field, Entity_Field -- search for comments + -- below). type Opt_Field_Enum is (No_Field, @@ -411,6 +421,7 @@ package Gen_IL.Fields is Uninitialized_Variable, Used_Operations, Was_Attribute_Reference, + Was_Default_Init_Box_Association, Was_Expression_Function, Was_Originally_Stub, @@ -430,7 +441,6 @@ package Gen_IL.Fields is Activation_Record_Component, Actual_Subtype, Address_Taken, --- ?? Alias, Alignment, Anonymous_Designated_Type, Anonymous_Masters, @@ -852,10 +862,8 @@ package Gen_IL.Fields is Related_Instance, Related_Type, Relative_Deadline_Variable, --- ??? Renamed_Entity, Renamed_In_Spec, --- ??? Renamed_Object, - Renamed_Or_Alias, -- ???Replaces Alias, Renamed_Entity, Renamed_Object + Renamed_Or_Alias, -- Shared among Alias, Renamed_Entity, Renamed_Object Renaming_Map, Requires_Overriding, Return_Applies_To, @@ -913,11 +921,24 @@ package Gen_IL.Fields is 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 + 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_Field is Field_Enum with Predicate => + Node_Header_Field in Nkind .. Link | Ekind; + + use Gen_IL.Types; + + subtype Node_Header_Type is Type_Enum range + Node_Kind_Type .. Union_Id; + -- Types of node header fields + end Gen_IL.Fields; diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 52cf72d0762..2c486dc21e7 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -25,29 +25,30 @@ procedure Gen_IL.Gen.Gen_Entities is - procedure Ab + procedure Ab -- Short for "Abstract" (T : Abstract_Entity; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields) renames Create_Abstract_Entity_Type; - procedure Cc + procedure Cc -- Short for "ConCrete" (T : Concrete_Entity; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields) renames Create_Concrete_Entity_Type; - function Sm + -- No Sy (Syntactic) fields in entities + 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 + Pre, Pre_Get, Pre_Set : String := "") return Field_Desc renames Create_Semantic_Field; procedure Union (T : Abstract_Entity; Children : Type_Array) - renames Create_Entity_Union; + renames Create_Entity_Union_Type; begin -- Gen_IL.Gen.Gen_Entities pragma Style_Checks ("M200"); Create_Root_Entity_Type (Entity_Kind, - (Sm (Ekind, Ekind_Type), + (Sm (Ekind, Entity_Kind_Type), Sm (Basic_Convention, Convention_Id), Sm (Address_Taken, Flag), Sm (Associated_Entity, Node_Id), @@ -199,7 +200,7 @@ begin -- Gen_IL.Gen.Gen_Entities 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_Type, Flag), Sm (Is_Volatile_Object, Flag), Sm (Is_Volatile_Full_Access, Flag), Sm (Kill_Elaboration_Checks, Flag), @@ -237,6 +238,11 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Was_Hidden, Flag))); Cc (E_Void, Entity_Kind, + -- 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). (Sm (Alignment, Uint), Sm (Contract, Node_Id), Sm (Is_Elaboration_Warnings_OK_Id, Flag), @@ -251,8 +257,8 @@ begin -- Gen_IL.Gen.Gen_Entities 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. + -- If we set the Ekind field properly before setting the following + -- fields, then these would not be needed in E_Void. Sm (Accept_Address, Elist_Id), Sm (Associated_Formal_Package, Node_Id), Sm (Associated_Node_For_Itype, Node_Id), @@ -264,7 +270,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Discriminant_Number, Uint), Sm (Enclosing_Scope, Node_Id), Sm (Entry_Bodies_Array, Node_Id, - Pre => "Has_Entries (N)"), -- This can't be right???? + Pre => "Has_Entries (N)"), Sm (Entry_Cancel_Parameter, Node_Id), Sm (Entry_Component, Node_Id), Sm (Entry_Formal, Node_Id), @@ -277,7 +283,6 @@ begin -- Gen_IL.Gen.Gen_Entities 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), @@ -289,25 +294,17 @@ begin -- Gen_IL.Gen.Gen_Entities 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. + -- For the above "setter only" fields, the setters are called for E_Void, + -- but not getters; the Ekind is modified before any such getters are + -- called. Ab (Object_Kind, Entity_Kind, (Sm (Current_Value, Node_Id), Sm (Renamed_Or_Alias, Node_Id))); Cc (E_Component, Object_Kind, + -- Components of a record declaration, private declarations of + -- protected objects. (Sm (Component_Bit_Offset, Uint), Sm (Component_Clause, Node_Id), Sm (Corresponding_Record_Component, Node_Id), @@ -329,6 +326,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Related_Type, Node_Id))); Cc (E_Constant, Object_Kind, + -- Constants created by an object declaration with a constant keyword (Sm (Activation_Record_Component, Node_Id), Sm (Actual_Subtype, Node_Id), Sm (Alignment, Uint), @@ -358,6 +356,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Status_Flag_Or_Transient_Decl, Node_Id))); Cc (E_Discriminant, Object_Kind, + -- A discriminant, created by the use of a discriminant in a type + -- declaration. (Sm (Component_Bit_Offset, Uint), Sm (Component_Clause, Node_Id), Sm (Corresponding_Discriminant, Node_Id), @@ -377,6 +377,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Original_Record_Component, Node_Id))); Cc (E_Loop_Parameter, Object_Kind, + -- A loop parameter created by a for loop (Sm (Activation_Record_Component, Node_Id), Sm (Alignment, Uint), Sm (Esize, Uint), @@ -387,6 +388,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Status_Flag_Or_Transient_Decl, Node_Id))); Cc (E_Variable, Object_Kind, + -- Variables created by an object declaration with no constant keyword (Sm (Activation_Record_Component, Node_Id), Sm (Actual_Subtype, Node_Id), Sm (Alignment, Uint), @@ -428,6 +430,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Validated_Object, Node_Id))); Ab (Formal_Kind, Object_Kind, + -- Formal parameters are also objects (Sm (Activation_Record_Component, Node_Id), Sm (Actual_Subtype, Node_Id), Sm (Alignment, Uint), @@ -449,31 +452,41 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Unset_Reference, Node_Id))); Cc (E_Out_Parameter, Formal_Kind, + -- An out parameter of a subprogram or entry (Sm (Last_Assignment, Node_Id))); Cc (E_In_Out_Parameter, Formal_Kind, + -- An in-out parameter of a subprogram or entry (Sm (Last_Assignment, Node_Id))); Cc (E_In_Parameter, Formal_Kind, + -- An in parameter of a subprogram or entry (Sm (Discriminal_Link, Node_Id), Sm (Discriminant_Default_Value, Node_Id), Sm (Is_Activation_Record, Flag))); Ab (Formal_Object_Kind, Object_Kind, + -- Generic formal objects are also objects (Sm (Entry_Component, Node_Id), Sm (Esize, Uint))); Cc (E_Generic_In_Out_Parameter, Formal_Object_Kind, + -- A generic in out parameter, created by the use of a generic in out + -- parameter in a generic declaration. (Sm (Actual_Subtype, Node_Id))); Cc (E_Generic_In_Parameter, Formal_Object_Kind); + -- A generic in parameter, created by the use of a generic in + -- parameter in a generic declaration. Ab (Named_Kind, Entity_Kind, (Sm (Renamed_Or_Alias, Node_Id))); Cc (E_Named_Integer, Named_Kind); + -- Named numbers created by a number declaration with an integer value Cc (E_Named_Real, Named_Kind); + -- Named numbers created by a number declaration with a real value Ab (Type_Kind, Entity_Kind, (Sm (Alignment, Uint), @@ -567,10 +580,13 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Lit_Hash, Node_Id, Root_Type_Only))); Cc (E_Enumeration_Type, Enumeration_Kind, + -- Enumeration types, created by an enumeration type declaration (Sm (Enum_Pos_To_Rep, Node_Id), Sm (First_Entity, Node_Id))); Cc (E_Enumeration_Subtype, Enumeration_Kind); + -- Enumeration subtypes, created by an explicit or implicit subtype + -- declaration applied to an enumeration type or subtype. Ab (Integer_Kind, Discrete_Kind, (Sm (Has_Shift_Operator, Flag, Base_Type_Only))); @@ -579,18 +595,28 @@ begin -- Gen_IL.Gen.Gen_Entities (Sm (First_Entity, Node_Id))); Cc (E_Signed_Integer_Type, Signed_Integer_Kind, + -- Signed integer type, used for the anonymous base type of the + -- integer subtype created by an integer type declaration. (Sm (Direct_Primitive_Operations, Elist_Id, Pre => "Is_Tagged_Type (N)"))); Cc (E_Signed_Integer_Subtype, Signed_Integer_Kind); + -- 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). 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); + -- Modular integer type, used for the anonymous base type of the + -- integer subtype created by a modular integer type declaration. Cc (E_Modular_Integer_Subtype, Modular_Integer_Kind); + -- 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). Ab (Real_Kind, Scalar_Kind, (Sm (Static_Real_Or_String_Predicate, Node_Id))); @@ -603,8 +629,14 @@ begin -- Gen_IL.Gen.Gen_Entities (Sm (Has_Small_Clause, Flag))); Cc (E_Ordinary_Fixed_Point_Type, Ordinary_Fixed_Point_Kind); + -- Ordinary fixed type, used for the anonymous base type of the fixed + -- subtype created by an ordinary fixed point type declaration. Cc (E_Ordinary_Fixed_Point_Subtype, Ordinary_Fixed_Point_Kind); + -- 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). Ab (Decimal_Fixed_Point_Kind, Fixed_Point_Kind, (Sm (Digits_Value, Uint), @@ -613,16 +645,28 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Scale_Value, Uint))); Cc (E_Decimal_Fixed_Point_Type, Decimal_Fixed_Point_Kind); + -- Decimal fixed type, used for the anonymous base type of the decimal + -- fixed subtype created by an ordinary fixed point type declaration. Cc (E_Decimal_Fixed_Point_Subtype, Decimal_Fixed_Point_Kind); + -- 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). 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); + -- Floating point type, used for the anonymous base type of the + -- floating point subtype created by a floating point type declaration. Cc (E_Floating_Point_Subtype, Float_Kind); + -- 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). Ab (Access_Kind, Elementary_Kind, (Sm (Associated_Storage_Pool, Node_Id, Root_Type_Only), @@ -640,21 +684,40 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Storage_Size_Variable, Node_Id, Impl_Base_Type_Only))); Cc (E_Access_Type, Access_Kind, + -- 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. (Sm (Direct_Primitive_Operations, Elist_Id, Pre => "Is_Tagged_Type (N)"))); Cc (E_Access_Subtype, Access_Kind); + -- An access subtype created by a subtype declaration for any access + -- type (whether or not it is a general access type). Cc (E_Access_Attribute_Type, Access_Kind); + -- An access type created for an access attribute (one of 'Access, + -- 'Unrestricted_Access, or Unchecked_Access). Cc (E_Allocator_Type, Access_Kind); + -- 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). Cc (E_General_Access_Type, Access_Kind, + -- An access type created by an access type declaration with the all + -- keyword present. (Sm (First_Entity, Node_Id))); Ab (Access_Subprogram_Kind, Access_Kind); Cc (E_Access_Subprogram_Type, Access_Subprogram_Kind, + -- An access-to-subprogram type, created by an access-to-subprogram + -- declaration. (Sm (Equivalent_Type, Node_Id), Sm (Original_Access_Type, Node_Id))); @@ -662,19 +725,27 @@ begin -- Gen_IL.Gen.Gen_Entities (Sm (Equivalent_Type, Node_Id))); Cc (E_Access_Protected_Subprogram_Type, Access_Protected_Kind); + -- 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. Cc (E_Anonymous_Access_Protected_Subprogram_Type, Access_Protected_Kind); + -- An anonymous access-to-protected-subprogram type, created by an + -- access-to-subprogram declaration. Cc (E_Anonymous_Access_Subprogram_Type, Access_Subprogram_Kind); + -- 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. Cc (E_Anonymous_Access_Type, Access_Kind); + -- An anonymous access-to-object type 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))); + (Sm (Discriminant_Constraint, Elist_Id, + Pre_Get => "Has_Discriminants (N) or else Is_Constrained (N)"))); Ab (Aggregate_Kind, Composite_Kind, (Sm (Component_Alignment, Component_Alignment_Kind, Base_Type_Only), @@ -694,10 +765,14 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Related_Array_Object, Node_Id))); Cc (E_Array_Type, Array_Kind, + -- An array type created by an array type declaration. Includes all + -- cases of arrays, except for string types. (Sm (First_Entity, Node_Id), Sm (Static_Real_Or_String_Predicate, Node_Id))); Cc (E_Array_Subtype, Array_Kind, + -- An array subtype, created by an explicit array subtype declaration, + -- or the use of an anonymous array subtype. (Sm (Predicated_Parent, Node_Id), Sm (Direct_Primitive_Operations, Elist_Id, Pre => "Is_Tagged_Type (N)"), @@ -705,6 +780,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Static_Real_Or_String_Predicate, Node_Id))); Cc (E_String_Literal_Subtype, Array_Kind, + -- A special string subtype, used only to describe the type of a string + -- literal (will always be one dimensional, with literal bounds). (Sm (String_Literal_Length, Uint), Sm (String_Literal_Low_Bound, Node_Id))); @@ -725,13 +802,19 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Stored_Constraint, Elist_Id))); Cc (E_Class_Wide_Type, Class_Wide_Kind, + -- 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). (Sm (Corresponding_Remote_Type, Node_Id), Sm (Scalar_Range, Node_Id))); Cc (E_Class_Wide_Subtype, Class_Wide_Kind, + -- A subtype of a class wide type, created by a subtype declaration + -- used to declare a subtype of a class type. (Sm (Cloned_Subtype, Node_Id))); Cc (E_Record_Type, Aggregate_Kind, + -- A record type, created by a record type declaration (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), @@ -752,6 +835,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Underlying_Record_View, Node_Id))); Cc (E_Record_Subtype, Aggregate_Kind, + -- A record subtype, created by a record subtype declaration (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), @@ -782,6 +866,11 @@ begin -- Gen_IL.Gen.Gen_Entities (Sm (Underlying_Full_View, Node_Id))); Cc (E_Record_Type_With_Private, Private_Kind, + -- 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. (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), @@ -802,6 +891,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Underlying_Record_View, Node_Id))); Cc (E_Record_Subtype_With_Private, Private_Kind, + -- A subtype of a type defined by a private extension declaration (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), @@ -820,21 +910,29 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (SSO_Set_Low_By_Default, Flag, Base_Type_Only))); Cc (E_Private_Type, Private_Kind, + -- A private type, created by a private type declaration that has + -- neither the keyword limited nor the keyword tagged. (Sm (Direct_Primitive_Operations, Elist_Id, Pre => "Is_Tagged_Type (N)"), Sm (Scalar_Range, Node_Id), Sm (Scope_Depth_Value, Uint))); Cc (E_Private_Subtype, Private_Kind, + -- A subtype of a private type, created by a subtype declaration used + -- to declare a subtype of a private type. (Sm (Direct_Primitive_Operations, Elist_Id, Pre => "Is_Tagged_Type (N)"), Sm (Scope_Depth_Value, Uint))); Cc (E_Limited_Private_Type, Private_Kind, + -- A limited private type, created by a private type declaration that + -- has the keyword limited, but not the keyword tagged. (Sm (Scalar_Range, Node_Id), Sm (Scope_Depth_Value, Uint))); Cc (E_Limited_Private_Subtype, Private_Kind, + -- A subtype of a limited private type, created by a subtype declaration + -- used to declare a subtype of a limited private type. (Sm (Scope_Depth_Value, Uint))); Ab (Incomplete_Kind, Incomplete_Or_Private_Kind, @@ -843,9 +941,12 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Non_Limited_View, Node_Id))); Cc (E_Incomplete_Type, Incomplete_Kind, + -- An incomplete type, created by an incomplete type declaration (Sm (Scalar_Range, Node_Id))); Cc (E_Incomplete_Subtype, Incomplete_Kind); + -- An incomplete subtype, created by a subtype declaration where the + -- subtype mark denotes an incomplete type. Ab (Concurrent_Kind, Composite_Kind, (Sm (Corresponding_Record_Type, Node_Id), @@ -866,12 +967,17 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Task_Body_Procedure, Node_Id))); Cc (E_Task_Type, Task_Kind, + -- 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. (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); + -- A subtype of a task type, created by a subtype declaration used to + -- declare a subtype of a task type. Ab (Protected_Kind, Concurrent_Kind, (Sm (Entry_Bodies_Array, Node_Id, @@ -879,6 +985,9 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Uses_Lock_Free, Flag))); Cc (E_Protected_Type, Protected_Kind, + -- 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. (Sm (Anonymous_Object, Node_Id), Sm (Entry_Max_Queue_Lengths_Array, Node_Id), Sm (Ignore_SPARK_Mode_Pragmas, Flag), @@ -886,11 +995,18 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (SPARK_Aux_Pragma_Inherited, Flag))); Cc (E_Protected_Subtype, Protected_Kind); + -- A subtype of a protected type, created by a subtype declaration used + -- to declare a subtype of a protected type. Cc (E_Exception_Type, Type_Kind, + -- The type of an exception created by an exception declaration (Sm (Equivalent_Type, Node_Id))); Cc (E_Subprogram_Type, Type_Kind, + -- 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. (Sm (Access_Subprogram_Wrapper, Node_Id), Sm (Extra_Accessibility_Of_Result, Node_Id), Sm (Extra_Formals, Node_Id), @@ -907,6 +1023,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Requires_Overriding, Flag))); Cc (E_Enumeration_Literal, Overloadable_Kind, + -- An enumeration literal, created by the use of the literal in an + -- enumeration type definition. (Sm (Enumeration_Pos, Uint), Sm (Enumeration_Rep, Uint), Sm (Enumeration_Rep_Expr, Node_Id), @@ -942,17 +1060,14 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Subps_Index, Uint))); Cc (E_Function, Subprogram_Kind, + -- A function, created by a function declaration or a function body + -- that acts as its own declaration. (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 (DT_Position, Uint, + Pre_Get => "Present (DTC_Entity (N))"), Sm (DTC_Entity, Node_Id), Sm (Extra_Accessibility_Of_Result, Node_Id), Sm (Generic_Renamings, Elist_Id), @@ -986,16 +1101,20 @@ begin -- Gen_IL.Gen.Gen_Entities Pre => "Is_Primitive_Wrapper (N)"))); Cc (E_Operator, Subprogram_Kind, + -- 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. (Sm (Extra_Accessibility_Of_Result, Node_Id))); Cc (E_Procedure, Subprogram_Kind, + -- A procedure, created by a procedure declaration or a procedure + -- body that acts as its own declaration. (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 (DT_Position, Uint, + Pre_Get => "Present (DTC_Entity (N))"), Sm (DTC_Entity, Node_Id), Sm (Entry_Parameters_Type, Node_Id), Sm (Generic_Renamings, Elist_Id), @@ -1031,6 +1150,9 @@ begin -- Gen_IL.Gen.Gen_Entities Pre => "Is_Primitive_Wrapper (N)"))); Cc (E_Abstract_State, Overloadable_Kind, + -- A state abstraction. Used to designate entities introduced by aspect + -- or pragma Abstract_State. The entity carries the various properties + -- of the state. (Sm (Body_References, Elist_Id), Sm (Encapsulating_State, Node_Id), Sm (First_Entity, Node_Id), @@ -1043,6 +1165,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (SPARK_Pragma_Inherited, Flag))); Cc (E_Entry, Overloadable_Kind, + -- An entry, created by an entry declaration in a task or protected + -- object. (Sm (Accept_Address, Elist_Id), Sm (Barrier_Function, Node_Id), Sm (Contract, Node_Id), @@ -1065,6 +1189,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (SPARK_Pragma_Inherited, Flag))); Cc (E_Entry_Family, Entity_Kind, + -- An entry family, created by an entry family declaration in a + -- task or protected type definition. (Sm (Accept_Address, Elist_Id), Sm (Barrier_Function, Node_Id), Sm (Contract, Node_Id), @@ -1090,6 +1216,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (SPARK_Pragma_Inherited, Flag))); Cc (E_Block, Entity_Kind, + -- A block identifier, created by an explicit or implicit label on + -- a block or declare statement. (Sm (Block_Node, Node_Id), Sm (Entry_Cancel_Parameter, Node_Id), Sm (First_Entity, Node_Id), @@ -1100,9 +1228,14 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Scope_Depth_Value, Uint))); Cc (E_Entry_Index_Parameter, Entity_Kind, + -- An entry index parameter created by an entry index specification + -- for the body of a protected entry family. (Sm (Entry_Index_Constant, Node_Id))); Cc (E_Exception, Entity_Kind, + -- 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. (Sm (Alignment, Uint), Sm (Esize, Uint), Sm (Interface_Name, Node_Id), @@ -1135,11 +1268,17 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Overridden_Operation, Node_Id))); Cc (E_Generic_Function, Generic_Subprogram_Kind, + -- A generic function. This is the entity for a generic function + -- created by a generic subprogram declaration. (Sm (Has_Missing_Return, Flag))); Cc (E_Generic_Procedure, Generic_Subprogram_Kind); + -- A generic function. This is the entity for a generic procedure + -- created by a generic subprogram declaration. Cc (E_Generic_Package, Generic_Unit_Kind, + -- A generic package, this is the entity for a generic package created + -- by a generic package declaration. (Sm (Abstract_States, Elist_Id), Sm (Body_Entity, Node_Id), Sm (First_Private_Entity, Node_Id), @@ -1149,10 +1288,15 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (SPARK_Aux_Pragma_Inherited, Flag))); Cc (E_Label, Entity_Kind, + -- 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. (Sm (Enclosing_Scope, Node_Id), Sm (Renamed_Or_Alias, Node_Id))); Cc (E_Loop, Entity_Kind, + -- A loop identifier, created by an explicit or implicit label on a + -- loop statement. (Sm (First_Entity, Node_Id), Sm (First_Exit_Statement, Node_Id), Sm (Has_Loop_Entry_Attributes, Flag), @@ -1161,12 +1305,19 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Scope_Depth_Value, Uint))); Cc (E_Return_Statement, Entity_Kind, + -- 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. (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, + -- A package, created by a package declaration (Sm (Abstract_States, Elist_Id), Sm (Anonymous_Masters, Elist_Id), Sm (Associated_Formal_Package, Node_Id), @@ -1209,6 +1360,10 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Static_Elaboration_Desired, Flag))); Cc (E_Package_Body, Entity_Kind, + -- 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. (Sm (Contract, Node_Id), Sm (Finalizer, Node_Id), Sm (First_Entity, Node_Id), @@ -1230,12 +1385,20 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (SPARK_Pragma_Inherited, Flag))); Cc (E_Protected_Body, Concurrent_Body_Kind); + -- A protected body. This entity serves almost no function, since all + -- semantic analysis uses the protected entity (E_Protected_Type). Cc (E_Task_Body, Concurrent_Body_Kind, + -- A task body. This entity serves almost no function, since all + -- semantic analysis uses the protected entity (E_Task_Type). (Sm (Contract, Node_Id), Sm (First_Entity, Node_Id))); Cc (E_Subprogram_Body, Entity_Kind, + -- 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). (Sm (Anonymous_Masters, Elist_Id), Sm (Contract, Node_Id), Sm (Extra_Formals, Node_Id), @@ -1278,6 +1441,16 @@ begin -- Gen_IL.Gen.Gen_Entities (E_Entry, E_Entry_Family)); + Union (Named_Access_Kind, + Children => + (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)); + Union (Numeric_Kind, Children => (Integer_Kind, diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index d02e2d463df..2405fd75bb8 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -37,35 +37,22 @@ procedure Gen_IL.Gen.Gen_Nodes is function Sy -- Short for "Syntactic" (Field : Node_Field; Field_Type : Type_Enum; Default_Value : Field_Default_Value := No_Default; - Pre : String := "") return Field_Desc + Pre, Pre_Get, Pre_Set : 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 + Pre, Pre_Get, Pre_Set : String := "") return Field_Desc renames Create_Semantic_Field; procedure Union (T : Abstract_Node; Children : Type_Array) - renames Create_Node_Union; + renames Create_Node_Union_Type; 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 (Nkind, Node_Kind_Type), Sm (Sloc, Source_Ptr), Sm (In_List, Flag), Sm (Rewrite_Ins, Flag), @@ -121,6 +108,19 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Empty, Node_Kind, (Sy (Chars, Name_Id, Default_No_Name))); + -- The following getters and setters are called on Empty, + -- and are currently inherited from Node_Kind: + -- + -- Set_Comes_From_Source + -- Set_Sloc + -- + -- Comes_From_Source + -- Error_Posted + -- In_List + -- Link + -- Rewrite_Ins + -- Sloc + -- Small_Paren_Count Cc (N_Pragma_Argument_Association, Node_Kind, (Sy (Chars, Name_Id, Default_No_Name), @@ -147,6 +147,7 @@ begin -- Gen_IL.Gen.Gen_Nodes (Sy (Chars, Name_Id, Default_No_Name))); Ab (N_Subexpr, N_Has_Etype, + -- Nodes with expression fields (Sm (Assignment_OK, Flag), Sm (Do_Range_Check, Flag), Sm (Has_Dynamic_Length_Check, Flag), @@ -157,6 +158,9 @@ begin -- Gen_IL.Gen.Gen_Nodes Sm (Raises_Constraint_Error, Flag))); Ab (N_Has_Entity, N_Subexpr, + -- Nodes that have Entity fields + -- Warning: DOES NOT INCLUDE N_Freeze_Entity, N_Freeze_Generic_Entity, + -- N_Aspect_Specification, or N_Attribute_Definition_Clause. (Sm (Entity_Or_Associated_Node, Node_Id))); -- both Cc (N_Expanded_Name, N_Has_Entity, @@ -247,6 +251,8 @@ begin -- Gen_IL.Gen.Gen_Nodes Sm (Do_Division_Check, Flag))); Ab (N_Op_Boolean, N_Binary_Op); + -- Binary operators that take operands of a boolean type, and yield a + -- result of a boolean type. Cc (N_Op_And, N_Op_Boolean, (Sm (Chars, Name_Id), @@ -566,6 +572,8 @@ begin -- Gen_IL.Gen.Gen_Nodes Sm (Must_Not_Freeze, Flag))); Ab (N_Declaration, Node_Kind); + -- Note: this includes all constructs normally thought of as declarations + -- except those which are separately grouped as later declarations. Cc (N_Component_Declaration, N_Declaration, (Sy (Defining_Identifier, Node_Id), @@ -717,6 +725,13 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Parameter_Specifications, List_Id, Default_No_List))); Ab (N_Later_Decl_Item, Node_Kind); + -- 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. Cc (N_Task_Type_Declaration, N_Later_Decl_Item, (Sy (Defining_Identifier, Node_Id), @@ -911,6 +926,10 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Name, Node_Id, Default_Empty))); Ab (N_Statement_Other_Than_Procedure_Call, Node_Kind); + -- 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). Cc (N_Abort_Statement, N_Statement_Other_Than_Procedure_Call, (Sy (Names, List_Id))); diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb index 70557296a03..6349841139b 100644 --- a/gcc/ada/gen_il-gen.adb +++ b/gcc/ada/gen_il-gen.adb @@ -39,36 +39,41 @@ package body Gen_IL.Gen is Inline : constant String := "Inline"; -- For experimenting with Inline_Always - Is_Syntactic : Fields_Per_Node_Type := + 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; + (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. + -- Called by Create_Node_Union_Type and Create_Entity_Union_Type 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; + (Field : Field_Enum; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value; + Type_Only : Type_Only_Enum; + Pre, Pre_Get, Pre_Set : 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 + -- Check some "legality" rules for types in the Gen_IL little language + + ---------------- + -- Check_Type -- + ---------------- procedure Check_Type (T : Node_Or_Entity_Type) is Im : constant String := Node_Or_Entity_Type'Image (T); @@ -96,8 +101,13 @@ package body Gen_IL.Gen is end if; end Check_Type; + ----------------- + -- Create_Type -- + ----------------- + procedure Create_Type - (T : Node_Or_Entity_Type; Parent : Opt_Abstract_Type; + (T : Node_Or_Entity_Type; + Parent : Opt_Abstract_Type; Fields : Field_Sequence) is begin @@ -121,8 +131,7 @@ package body Gen_IL.Gen is new Type_Info' (Is_Union => False, Parent => Parent, Children | Concrete_Descendants => Type_Vectors.Empty_Vector, - First | Last | Fields => <>, - Allow_Overlap => False); + First | Last | Fields => <>); -- filled in later if Parent /= No_Type then Append (Type_Table (Parent).Children, T); @@ -130,7 +139,7 @@ package body Gen_IL.Gen is -- 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. + -- Exempt Chars and Actions from this rule, for now. declare Semantic_Seen : Boolean := False; @@ -150,6 +159,35 @@ package body Gen_IL.Gen is end loop; end; + -- Check that node fields are in nodes, and entity fields are in + -- entities. + + for J in Fields'Range loop + declare + Field : constant Field_Enum := Fields (J).F; + Error_Prefix : constant String := + "Field " & Image (T) & "." & Image (Field) & " not in "; + begin + case T is + when Node_Type => + if Field not in Node_Field then + raise Illegal with Error_Prefix & "Node_Field"; + end if; + + when Entity_Type => + if Field not in Entity_Field then + raise Illegal with Error_Prefix & "Entity_Field"; + end if; + + when Type_Boundaries => + raise Program_Error; -- dummy types shouldn't have fields + end case; + end; + end loop; + + -- Compute the Have_This_Field component of fields, the Fields component + -- of the current type, and Syntactic table. + for J in Fields'Range loop declare Field : constant Field_Enum := Fields (J).F; @@ -159,8 +197,8 @@ package body Gen_IL.Gen is 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; + pragma Assert (not Syntactic (T) (Field)); + Syntactic (T) (Field) := Is_Syntactic; end; end loop; end Create_Type; @@ -168,68 +206,110 @@ package body Gen_IL.Gen is -- 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. + --------------------------- + -- Create_Root_Node_Type -- + --------------------------- + procedure Create_Root_Node_Type - (T : Abstract_Node; + (T : Abstract_Node; Fields : Field_Sequence := No_Fields) is begin Create_Type (T, Parent => No_Type, Fields => Fields); end Create_Root_Node_Type; + ------------------------------- + -- Create_Abstract_Node_Type -- + ------------------------------- + procedure Create_Abstract_Node_Type - (T : Abstract_Node; Parent : Abstract_Type; + (T : Abstract_Node; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields) is begin Create_Type (T, Parent, Fields); end Create_Abstract_Node_Type; + ------------------------------- + -- Create_Concrete_Node_Type -- + ------------------------------- + procedure Create_Concrete_Node_Type - (T : Concrete_Node; Parent : Abstract_Type; + (T : Concrete_Node; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields) is begin Create_Type (T, Parent, Fields); end Create_Concrete_Node_Type; + ----------------------------- + -- Create_Root_Entity_Type -- + ----------------------------- + procedure Create_Root_Entity_Type - (T : Abstract_Entity; + (T : Abstract_Entity; Fields : Field_Sequence := No_Fields) is begin Create_Type (T, Parent => No_Type, Fields => Fields); end Create_Root_Entity_Type; + --------------------------------- + -- Create_Abstract_Entity_Type -- + --------------------------------- + procedure Create_Abstract_Entity_Type - (T : Abstract_Entity; Parent : Abstract_Type; + (T : Abstract_Entity; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields) is begin Create_Type (T, Parent, Fields); end Create_Abstract_Entity_Type; + --------------------------------- + -- Create_Concrete_Entity_Type -- + --------------------------------- + procedure Create_Concrete_Entity_Type - (T : Concrete_Entity; Parent : Abstract_Type; + (T : Concrete_Entity; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields) is begin Create_Type (T, Parent, Fields); end Create_Concrete_Entity_Type; + ------------------ + -- Create_Field -- + ------------------ + 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 + (Field : Field_Enum; + Field_Type : Type_Enum; + Default_Value : Field_Default_Value; + Type_Only : Type_Only_Enum; + Pre, Pre_Get, Pre_Set : String; + Is_Syntactic : Boolean) return Field_Desc is begin + -- Note that this function has the side effect of update the + -- Field_Table. + pragma Assert (if Default_Value /= No_Default then Is_Syntactic); pragma Assert (if Type_Only /= No_Type_Only then not Is_Syntactic); + -- First time this field has been seen; create an entry in the + -- Field_Table. + 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 => <>); + Pre => new String'(Pre), + Pre_Get => new String'(Pre_Get), + Pre_Set => new String'(Pre_Set), + Offset => <>); -- filled in later + + -- The Field_Table entry has already been created by the 'then' part + -- above. Now we're seeing the same field being "created" again in a + -- different type. Here we check consistency of this new Create_Field + -- call with the old one. else if Field_Type /= Field_Table (Field).Field_Type then @@ -241,6 +321,9 @@ package body Gen_IL.Gen is -- 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. + -- + -- Note that the order of calls does not matter; a default value + -- always overrides a No_Default value. if Is_Syntactic then if Default_Value /= Field_Table (Field).Default_Value then @@ -261,34 +344,61 @@ package body Gen_IL.Gen is raise Illegal with "mismatched extra preconditions for " & Image (Field); end if; + + if Pre_Get /= Field_Table (Field).Pre_Get.all then + raise Illegal with + "mismatched extra getter-only preconditions for " & + Image (Field); + end if; + + if Pre /= Field_Table (Field).Pre.all then + raise Illegal with + "mismatched extra setter-only preconditions for " & + Image (Field); + end if; end if; return (Field, Is_Syntactic); end Create_Field; + ---------------------------- + -- Create_Syntactic_Field -- + ---------------------------- + function Create_Syntactic_Field (Field : Node_Field; Field_Type : Type_Enum; Default_Value : Field_Default_Value := No_Default; - Pre : String := "") return Field_Desc + Pre, Pre_Get, Pre_Set : String := "") return Field_Desc is begin return Create_Field - (Field, Field_Type, Default_Value, No_Type_Only, Pre, + (Field, Field_Type, Default_Value, No_Type_Only, + Pre, Pre_Get, Pre_Set, Is_Syntactic => True); end Create_Syntactic_Field; + --------------------------- + -- Create_Semantic_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 + Pre, Pre_Get, Pre_Set : String := "") return Field_Desc is begin return Create_Field - (Field, Field_Type, No_Default, Type_Only, Pre, Is_Syntactic => False); + (Field, Field_Type, No_Default, Type_Only, + Pre, Pre_Get, Pre_Set, + Is_Syntactic => False); end Create_Semantic_Field; + ----------------------- + -- Create_Union_Type -- + ----------------------- + procedure Create_Union_Type (Root : Root_Type; T : Abstract_Type; Children : Type_Array) is @@ -326,16 +436,29 @@ package body Gen_IL.Gen is end loop; end Create_Union_Type; - procedure Create_Node_Union (T : Abstract_Node; Children : Type_Array) is + ---------------------------- + -- Create_Node_Union_Type -- + ---------------------------- + + procedure Create_Node_Union_Type + (T : Abstract_Node; Children : Type_Array) is begin Create_Union_Type (Node_Kind, T, Children); - end Create_Node_Union; + end Create_Node_Union_Type; - procedure Create_Entity_Union + ------------------------------ + -- Create_Entity_Union_Type -- + ------------------------------ + + procedure Create_Entity_Union_Type (T : Abstract_Entity; Children : Type_Array) is begin Create_Union_Type (Entity_Kind, T, Children); - end Create_Entity_Union; + end Create_Entity_Union_Type; + + ------------- + -- Compile -- + ------------- procedure Compile is Fields_Per_Node : Fields_Per_Node_Type := (others => (others => False)); @@ -369,26 +492,29 @@ package body Gen_IL.Gen is procedure Compute_Ranges (Root : Root_Type); -- Compute the range of Node_Kind/Entity_Kind values for all the types - -- rooted at Root. + -- rooted at Root. The result is stored in the First and Last components + -- in the Type_Table. 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. + -- inherited ones. Set the Is_Syntactic component in the Type_Table 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. + -- Compute the offsets of each field. The results are stored in the + -- Offset components in the Field_Table. 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; + procedure Check_For_Syntactic_Field_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. + -- nodes in which they exist, except for some fields that already + -- violate this rule. -- -- Also sets Setter_Needs_Parent. @@ -422,12 +548,10 @@ package body Gen_IL.Gen is -- 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. + -- Name of the 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); @@ -443,7 +567,7 @@ package body Gen_IL.Gen is -- Print out the precondition, if any, for a getter or setter for the -- given field. - procedure Instantiate_Low_Level_Accessors + procedure Put_Low_Level_Accessor_Instantiations (S : in out Sink'Class; T : Type_Enum); -- Print out the low-level getter and setter for a given type @@ -505,10 +629,14 @@ package body Gen_IL.Gen is -- Used by Put_Sinfo_Dot_H and Put_Einfo_Dot_H to print out functions to -- test membership in a union type. + ------------------------ + -- Check_Completeness -- + ------------------------ + 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 + if Type_Table (T) = null and then T not in Type_Boundaries then raise Illegal with "Missing type declaration for " & Image (T); end if; end loop; @@ -522,27 +650,31 @@ package body Gen_IL.Gen is end loop; end Check_Completeness; + -------------------- + -- Compute_Ranges -- + -------------------- + 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 + procedure Add_Concrete_Descendant_To_Ancestors (Ancestor : Abstract_Type; Descendant : Concrete_Type); -- Add Descendant to the Concrete_Descendants of each of its -- ancestors. - procedure Add_Concrete_Descendant + procedure Add_Concrete_Descendant_To_Ancestors (Ancestor : Abstract_Type; Descendant : Concrete_Type) is begin if Ancestor not in Root_Type then - Add_Concrete_Descendant + Add_Concrete_Descendant_To_Ancestors (Type_Table (Ancestor).Parent, Descendant); end if; Append (Type_Table (Ancestor).Concrete_Descendants, Descendant); - end Add_Concrete_Descendant; + end Add_Concrete_Descendant_To_Ancestors; procedure Do_One_Type (T : Node_Or_Entity_Type) is begin @@ -551,7 +683,8 @@ package body Gen_IL.Gen is pragma Annotate (Codepeer, Modified, Type_Table); Type_Table (T).First := T; Type_Table (T).Last := T; - Add_Concrete_Descendant (Type_Table (T).Parent, T); + Add_Concrete_Descendant_To_Ancestors + (Type_Table (T).Parent, T); when Abstract_Type => declare @@ -584,6 +717,10 @@ package body Gen_IL.Gen is Iterate_Types (Root, Post => Do_One_Type'Access); end Compute_Ranges; + ----------------------------- + -- Compute_Fields_Per_Node -- + ----------------------------- + procedure Compute_Fields_Per_Node is Duplicate_Fields_Found : Boolean := False; @@ -592,12 +729,14 @@ package body Gen_IL.Gen is -- 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; + function Get_Syntactic_Fields + (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); + -- Do the Compute_Fields_Per_Node work for a concrete type function Get_Fields (T : Node_Or_Entity_Type) return Field_Vector is Parent_Fields : constant Field_Vector := @@ -607,19 +746,20 @@ package body Gen_IL.Gen is return Parent_Fields & Type_Table (T).Fields; end Get_Fields; - function Get_Is_Syntactic (T : Node_Or_Entity_Type) return Field_Set + function Get_Syntactic_Fields + (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)); + else Get_Syntactic_Fields (Type_Table (T).Parent)); begin - return Parent_Is_Syntactic or Is_Syntactic (T); - end Get_Is_Syntactic; + return Parent_Is_Syntactic or Syntactic (T); + end Get_Syntactic_Fields; procedure Do_Concrete_Type (CT : Concrete_Type) is begin Type_Table (CT).Fields := Get_Fields (CT); - Is_Syntactic (CT) := Get_Is_Syntactic (CT); + Syntactic (CT) := Get_Syntactic_Fields (CT); for F of Type_Table (CT).Fields loop if Fields_Per_Node (CT) (F) then @@ -691,11 +831,23 @@ package body Gen_IL.Gen is 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 Node_Kind_Type | Entity_Kind_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 @@ -728,6 +880,10 @@ package body Gen_IL.Gen is function Type_Bit_Size_Aligned (T : Concrete_Type) return Bit_Offset is (Bit_Offset (Type_Size_In_Slots (T)) * 32); -- multiple of slot size + --------------------------- + -- Compute_Field_Offsets -- + --------------------------- + procedure Compute_Field_Offsets is type Offset_Set_Unconstrained is array (Bit_Offset range <>) of Boolean with Pack; @@ -752,7 +908,7 @@ package body Gen_IL.Gen is -- False, then "any type that has the field" --> "any type, whether -- or not it has the field". - procedure Set_Offset_Set + procedure Set_Offset_In_Use (F : Field_Enum; Offset : Field_Offset); -- Mark the offset as "in use" @@ -780,7 +936,7 @@ package body Gen_IL.Gen is return True; end Offset_OK; - procedure Set_Offset_Set + procedure Set_Offset_In_Use (F : Field_Enum; Offset : Field_Offset) is begin for T in Concrete_Type loop @@ -795,14 +951,14 @@ package body Gen_IL.Gen is end; end if; end loop; - end Set_Offset_Set; + end Set_Offset_In_Use; 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); + Set_Offset_In_Use (F, Offset); return Offset; end if; @@ -865,9 +1021,16 @@ package body Gen_IL.Gen is end Compute_Field_Offsets; + ------------------------ + -- Compute_Type_Sizes -- + ------------------------ + procedure Compute_Type_Sizes is -- Node_Counts is the number of nodes of each kind created during - -- compilation of a large example. + -- compilation of a large example. This is used purely to compute an + -- estimate of the average node size. New node types can default to + -- "others => 0". At some point we can instrument Atree to print out + -- accurate size statistics, and remove this code. Node_Counts : constant array (Concrete_Node) of Natural := (N_Identifier => 429298, @@ -1129,7 +1292,11 @@ package body Gen_IL.Gen is Average_Node_Size_In_Slots := Average_Type_Size_In_Slots; end Compute_Type_Sizes; - procedure Check_For_Syntactic_Mismatch is + ---------------------------------------- + -- Check_For_Syntactic_Field_Mismatch -- + ---------------------------------------- + + procedure Check_For_Syntactic_Field_Mismatch is begin for F in Field_Enum loop if F /= Between_Node_And_Entity_Fields then @@ -1140,7 +1307,7 @@ package body Gen_IL.Gen is begin for J in 1 .. Last_Index (Have_Field) loop - if Is_Syntactic (Have_Field (J)) (F) then + if Syntactic (Have_Field (J)) (F) then Syntactic_Seen := True; else Semantic_Seen := True; @@ -1162,7 +1329,7 @@ package body Gen_IL.Gen is "syntactic/semantic mismatch for " & Image (F); end if; - if Field_Table (F).Field_Type in Traversal_Type + if Field_Table (F).Field_Type in Traversed_Field_Type and then Syntactic_Seen then Setter_Needs_Parent (F) := True; @@ -1171,7 +1338,11 @@ package body Gen_IL.Gen is end; end if; end loop; - end Check_For_Syntactic_Mismatch; + end Check_For_Syntactic_Field_Mismatch; + + ---------------------- + -- Field_Types_Used -- + ---------------------- function Field_Types_Used (First, Last : Field_Enum) return Type_Set is Result : Type_Set := (others => False); @@ -1191,6 +1362,10 @@ package body Gen_IL.Gen is -- Lines of the form Put (S, "..."); are more readable if we relax the -- line length. We really just want the "..." to be short enough. + --------------------------- + -- Put_Type_And_Subtypes -- + --------------------------- + procedure Put_Type_And_Subtypes (S : in out Sink'Class; Root : Root_Type) is @@ -1254,7 +1429,7 @@ package body Gen_IL.Gen is Image (Root)); Indent (S, 2); Put (S, "\1 in\n", Image (T)); - Put_Images (S, Type_Table (T).Children); + Put_Types_With_Bars (S, Type_Table (T).Children); Outdent (S, 2); Put (S, ";\n"); Outdent (S, 2); @@ -1283,9 +1458,6 @@ package body Gen_IL.Gen is 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); @@ -1357,15 +1529,19 @@ package body Gen_IL.Gen is Put (S, "subtype Flag is Boolean;\n\n"); end Put_Type_And_Subtypes; - function Low_Level_Getter (T : Type_Enum) return String is + function Low_Level_Getter_Name (T : Type_Enum) return String is ("Get_" & Image (T)); - function Low_Level_Setter (T : Type_Enum) return String is + function Low_Level_Setter_Name (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) & + function Low_Level_Setter_Name (F : Field_Enum) return String is + (Low_Level_Setter_Name (Field_Table (F).Field_Type) & (if Setter_Needs_Parent (F) then "_With_Parent" else "")); - procedure Instantiate_Low_Level_Accessors + ------------------------------------------- + -- Put_Low_Level_Accessor_Instantiations -- + ------------------------------------------- + + procedure Put_Low_Level_Accessor_Instantiations (S : in out Sink'Class; T : Type_Enum) is begin @@ -1381,7 +1557,7 @@ package body Gen_IL.Gen is begin Put (S, "\nfunction \1 is new Get_32_Bit_Field_With_Default (\2, \3) with \4;\n", - Low_Level_Getter (T), + Low_Level_Getter_Name (T), Get_Set_Id_Image (T), Default_Val, Inline); @@ -1392,7 +1568,7 @@ package body Gen_IL.Gen is else Put (S, "\nfunction \1 is new Get_\2_Bit_Field (\3) with \4;\n", - Low_Level_Getter (T), + Low_Level_Getter_Name (T), Image (Field_Size (T)), Get_Set_Id_Image (T), Inline); @@ -1400,21 +1576,25 @@ package body Gen_IL.Gen is -- No special case for the setter - if T in Nkind_Type | Ekind_Type then + if T in Node_Kind_Type | Entity_Kind_Type then Put (S, "pragma Warnings (Off);\n"); - -- Set_Nkind_Type and Set_Ekind_Type might not be called + -- Set_Node_Kind_Type and Set_Entity_Kind_Type might not be called end if; Put (S, "procedure \1 is new Set_\2_Bit_Field (\3) with \4;\n", - Low_Level_Setter (T), + Low_Level_Setter_Name (T), Image (Field_Size (T)), Get_Set_Id_Image (T), Inline); - if T in Nkind_Type | Ekind_Type then + if T in Node_Kind_Type | Entity_Kind_Type then Put (S, "pragma Warnings (On);\n"); end if; - end Instantiate_Low_Level_Accessors; + end Put_Low_Level_Accessor_Instantiations; + + ---------------------- + -- Put_Precondition -- + ---------------------- procedure Put_Precondition (S : in out Sink'Class; F : Field_Enum) @@ -1452,7 +1632,7 @@ package body Gen_IL.Gen is Put (S, ", Pre =>\n"); Indent (S, 1); Put (S, "N in "); - Put_Id_Images (S, Field_Table (F).Have_This_Field); + Put_Type_Ids_With_Bars (S, Field_Table (F).Have_This_Field); pragma Assert (Is_Entity = ""); @@ -1477,6 +1657,10 @@ package body Gen_IL.Gen is -- Node_Id or Entity_Id, and the getter and setter will have -- preconditions. + ------------------------ + -- Node_To_Fetch_From -- + ------------------------ + function Node_To_Fetch_From (F : Field_Enum) return String is begin return @@ -1487,6 +1671,10 @@ package body Gen_IL.Gen is when Root_Type_Only => "Root_Type (N)"); end Node_To_Fetch_From; + --------------------- + -- Put_Getter_Spec -- + --------------------- + procedure Put_Getter_Spec (S : in out Sink'Class; F : Field_Enum) is begin Put (S, "function \1\n", Image (F)); @@ -1496,6 +1684,10 @@ package body Gen_IL.Gen is Outdent (S, 2); end Put_Getter_Spec; + --------------------- + -- Put_Getter_Decl -- + --------------------- + procedure Put_Getter_Decl (S : in out Sink'Class; F : Field_Enum) is begin Put_Getter_Spec (S, F); @@ -1507,6 +1699,10 @@ package body Gen_IL.Gen is Put (S, ";\n"); end Put_Getter_Decl; + --------------------- + -- Put_Getter_Body -- + --------------------- + procedure Put_Getter_Body (S : in out Sink'Class; F : Field_Enum) is Rec : Field_Info renames Field_Table (F).all; begin @@ -1521,7 +1717,7 @@ package body Gen_IL.Gen is Indent (S, 3); Put (S, "Val : constant \1 := \2 (\3, \4);\n", Get_Set_Id_Image (Rec.Field_Type), - Low_Level_Getter (Rec.Field_Type), + Low_Level_Getter_Name (Rec.Field_Type), Node_To_Fetch_From (F), Image (Rec.Offset)); Outdent (S, 3); @@ -1532,11 +1728,19 @@ package body Gen_IL.Gen is Put (S, "pragma Assert (\1);\n", Rec.Pre.all); end if; + if Rec.Pre_Get.all /= "" then + Put (S, "pragma Assert (\1);\n", Rec.Pre_Get.all); + end if; + Put (S, "return Val;\n"); Outdent (S, 3); Put (S, "end \1;\n\n", Image (F)); end Put_Getter_Body; + --------------------- + -- Put_Setter_Spec -- + --------------------- + procedure Put_Setter_Spec (S : in out Sink'Class; F : Field_Enum) is Rec : Field_Info renames Field_Table (F).all; Default : constant String := @@ -1550,6 +1754,10 @@ package body Gen_IL.Gen is Outdent (S, 2); end Put_Setter_Spec; + --------------------- + -- Put_Setter_Decl -- + --------------------- + procedure Put_Setter_Decl (S : in out Sink'Class; F : Field_Enum) is begin Put_Setter_Spec (S, F); @@ -1560,23 +1768,22 @@ package body Gen_IL.Gen is Put (S, ";\n"); end Put_Setter_Decl; + --------------------- + -- Put_Setter_Body -- + --------------------- + procedure Put_Setter_Body (S : in out Sink'Class; F : Field_Enum) is Rec : Field_Info renames Field_Table (F).all; -- If Type_Only was specified in the call to Create_Semantic_Field, - -- then we assert that the node is a base (etc) type. + -- then we assert that the node is a base type. We cannot assert that + -- it is an implementation base type or a root type. Type_Only_Assertion : constant String := (case Rec.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)"); + when Base_Type_Only | Impl_Base_Type_Only | Root_Type_Only => + "Is_Base_Type (N)"); begin Put_Setter_Spec (S, F); Put (S, " is\n"); @@ -1587,17 +1794,25 @@ package body Gen_IL.Gen is Put (S, "pragma Assert (\1);\n", Rec.Pre.all); end if; + if Rec.Pre_Set.all /= "" then + Put (S, "pragma Assert (\1);\n", Rec.Pre_Set.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), + Low_Level_Setter_Name (F), Image (Rec.Offset)); Outdent (S, 3); Put (S, "end Set_\1;\n\n", Image (F)); end Put_Setter_Body; + -------------------- + -- Put_Subp_Decls -- + -------------------- + 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, @@ -1626,6 +1841,10 @@ package body Gen_IL.Gen is end loop; end Put_Subp_Decls; + --------------------- + -- Put_Subp_Bodies -- + --------------------- + procedure Put_Subp_Bodies (S : in out Sink'Class; Root : Root_Type) is begin Put (S, "\n-- Getters and setters for fields\n\n"); @@ -1639,6 +1858,10 @@ package body Gen_IL.Gen is end loop; end Put_Subp_Bodies; + -------------------------- + -- Put_Traversed_Fields -- + -------------------------- + procedure Put_Traversed_Fields (S : in out Sink'Class) is function Is_Traversed_Field @@ -1651,19 +1874,19 @@ package body Gen_IL.Gen is -- 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); + procedure Put_Aggregate (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; + return Syntactic (T) (F) + and then Field_Table (F).Field_Type in Traversed_Field_Type; end Is_Traversed_Field; First_Time : Boolean := True; - procedure Put_Agg (T : Node_Or_Entity_Type) is + procedure Put_Aggregate (T : Node_Or_Entity_Type) is Left_Opnd_Skipped : Boolean := False; begin if T in Concrete_Node then @@ -1706,7 +1929,7 @@ package body Gen_IL.Gen is Outdent (S, 2); Put (S, ")"); end if; - end Put_Agg; + end Put_Aggregate; function Init_Max_Traversed_Fields return Field_Offset is Result : Field_Offset := 0; @@ -1752,12 +1975,16 @@ package body Gen_IL.Gen is Indent (S, 2); Put (S, "("); Indent (S, 1); - Iterate_Types (Node_Kind, Pre => Put_Agg'Access); + Iterate_Types (Node_Kind, Pre => Put_Aggregate'Access); Outdent (S, 1); Put (S, ");\n\n"); Outdent (S, 2); end Put_Traversed_Fields; + ---------------- + -- Put_Tables -- + ---------------- + procedure Put_Tables (S : in out Sink'Class; Root : Root_Type) is First_Time : Boolean := True; @@ -1942,6 +2169,10 @@ package body Gen_IL.Gen is end Put_Tables; + ---------------- + -- Put_Seinfo -- + ---------------- + procedure Put_Seinfo is S : Sink'Class := Create_File ("seinfo.ads"); begin @@ -2010,6 +2241,10 @@ package body Gen_IL.Gen is Put (S, "\nend Seinfo;\n"); end Put_Seinfo; + --------------- + -- Put_Nodes -- + --------------- + procedure Put_Nodes is S : Sink'Class := Create_File ("sinfo-nodes.ads"); B : Sink'Class := Create_File ("sinfo-nodes.adb"); @@ -2091,7 +2326,7 @@ package body Gen_IL.Gen is 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); + Put_Low_Level_Accessor_Instantiations (B, T); end if; end loop; @@ -2105,15 +2340,16 @@ package body Gen_IL.Gen is end Put_Nodes; + ------------------ + -- Put_Entities -- + ------------------ + 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); @@ -2146,7 +2382,7 @@ package body Gen_IL.Gen is 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); + Put_Low_Level_Accessor_Instantiations (B, T); end if; end loop; @@ -2157,17 +2393,23 @@ package body Gen_IL.Gen is end Put_Entities; + ------------------- + -- Put_Make_Spec -- + ------------------- + 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); + Put (S, "function Make_\1\n", Image_Sans_N (T)); + Indent (S, 2); + Put (S, "(Sloc : Source_Ptr"); + Indent (S, 1); for F of Type_Table (T).Fields loop pragma Assert (Fields_Per_Node (T) (F)); - if Is_Syntactic (T) (F) then + if Syntactic (T) (F) then declare Typ : constant String := (if Field_Table (F).Field_Type = Flag then "Boolean" @@ -2181,141 +2423,136 @@ package body Gen_IL.Gen is (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)); + Put (S, " : \1\2", Typ, Default); end; end if; end loop; Put (S, ")\nreturn \1_Id", Node_Or_Entity (Root)); - Outdent (S, 3); + Outdent (S, 2); + Outdent (S, 1); end Put_Make_Spec; + -------------------- + -- Put_Make_Decls -- + -------------------- + 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)); + for T in First_Concrete (Root) .. Last_Concrete (Root) loop + if T not in N_Unused_At_Start | N_Unused_At_End then + Put_Make_Spec (S, Root, T); + Put (S, ";\npragma \1 (Make_\2);\n\n", Inline, Image_Sans_N (T)); + end if; end loop; end Put_Make_Decls; + --------------------- + -- Put_Make_Bodies -- + --------------------- + 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"); + for T in First_Concrete (Root) .. Last_Concrete (Root) loop + if T not in N_Unused_At_Start | N_Unused_At_End then + Put_Make_Spec (S, Root, T); + Put (S, "\nis\n"); - Indent (S, 3); - Put (S, "N : constant Node_Id :=\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)); + 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; + else + Put (S, " New_Node (\1, Sloc);\n", Image (T)); + end if; - Outdent (S, 3); + Outdent (S, 3); - Put (S, "begin\n"); + Put (S, "begin\n"); - Indent (S, 3); - for F of Type_Table (T).Fields loop - pragma Assert (Fields_Per_Node (T) (F)); + 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. + if 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); + F_Name : constant String := Image (F); - begin - if F_Name'Length < NWidth then - Put (S, "Set_\1 (N, \1);\n", F_Name); + begin + if F_Name'Length < NWidth then + Put (S, "Set_\1 (N, \1);\n", F_Name); - -- Wrap the line + -- 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; + 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. + 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. + 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; + 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, "return N;\n"); + Outdent (S, 3); - Put (S, "end Make_\1;\n\n", Image_Sans_N (T)); + Put (S, "end Make_\1;\n\n", Image_Sans_N (T)); + end if; end loop; end Put_Make_Bodies; + --------------- + -- Put_Nmake -- + --------------- + -- Documentation for the Nmake package, generated by Put_Nmake below. -- The Nmake package contains a set of routines used to construct tree @@ -2353,8 +2590,6 @@ package body Gen_IL.Gen is 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); @@ -2371,8 +2606,6 @@ package body Gen_IL.Gen is 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); @@ -2380,11 +2613,15 @@ package body Gen_IL.Gen is Put (B, "end Nmake;\n"); end Put_Nmake; + ----------------------- + -- Put_Seinfo_Tables -- + ----------------------- + 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; + Type_Layout : Concrete_Type_Layout_Array; function Get_Last_Bit (T : Concrete_Type; F : Opt_Field_Enum; First_Bit : Bit_Offset) @@ -2514,7 +2751,7 @@ package body Gen_IL.Gen is 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, "with Gen_IL.Internals; use Gen_IL.Internals;\n"); Put (B, "\npackage body Seinfo_Tables is\n\n"); Indent (B, 3); @@ -2537,7 +2774,7 @@ package body Gen_IL.Gen is 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"); + Put (B, "Type_Layout : constant Concrete_Type_Layout_Array := \n"); Indent (B, 2); Put (B, "-- Concrete node types:\n"); Put (B, "("); @@ -2665,6 +2902,10 @@ package body Gen_IL.Gen is end Put_Seinfo_Tables; + ----------------------------- + -- Put_C_Type_And_Subtypes -- + ----------------------------- + procedure Put_C_Type_And_Subtypes (S : in out Sink'Class; Root : Root_Type) is @@ -2714,6 +2955,10 @@ package body Gen_IL.Gen is Put_Union_Membership (S, Root); end Put_C_Type_And_Subtypes; + ---------------------------- + -- Put_Low_Level_C_Getter -- + ---------------------------- + procedure Put_Low_Level_C_Getter (S : in out Sink'Class; T : Type_Enum) is @@ -2727,7 +2972,7 @@ package body Gen_IL.Gen is Indent (S, 3); - -- Same special case as in Instantiate_Low_Level_Accessors + -- Same special case as in Put_Low_Level_Accessor_Instantiations if T in Elist_Id | Uint then pragma Assert (Field_Size (T) = 32); @@ -2749,6 +2994,10 @@ package body Gen_IL.Gen is Outdent (S, 3); end Put_Low_Level_C_Getter; + ----------------------------- + -- Put_High_Level_C_Getter -- + ----------------------------- + procedure Put_High_Level_C_Getter (S : in out Sink'Class; F : Field_Enum) is @@ -2759,12 +3008,16 @@ package body Gen_IL.Gen is Indent (S, 3); Put (S, "{ return \1(\2, \3); }\n\n", - Low_Level_Getter (Field_Table (F).Field_Type), + Low_Level_Getter_Name (Field_Table (F).Field_Type), Node_To_Fetch_From (F), Image (Field_Table (F).Offset)); Outdent (S, 3); end Put_High_Level_C_Getter; + ------------------------------ + -- Put_High_Level_C_Getters -- + ------------------------------ + procedure Put_High_Level_C_Getters (S : in out Sink'Class; Root : Root_Type) is @@ -2776,6 +3029,10 @@ package body Gen_IL.Gen is end loop; end Put_High_Level_C_Getters; + -------------------------- + -- Put_Union_Membership -- + -------------------------- + procedure Put_Union_Membership (S : in out Sink'Class; Root : Root_Type) is @@ -2835,6 +3092,10 @@ package body Gen_IL.Gen is end loop; end Put_Union_Membership; + --------------------- + -- Put_Sinfo_Dot_H -- + --------------------- + procedure Put_Sinfo_Dot_H is S : Sink'Class := Create_File ("sinfo.h"); @@ -2861,6 +3122,10 @@ package body Gen_IL.Gen is Put (S, "#endif\n"); end Put_Sinfo_Dot_H; + --------------------- + -- Put_Einfo_Dot_H -- + --------------------- + procedure Put_Einfo_Dot_H is S : Sink'Class := Create_File ("einfo.h"); @@ -2946,7 +3211,7 @@ package body Gen_IL.Gen is Compute_Fields_Per_Node; Compute_Field_Offsets; Compute_Type_Sizes; - Check_For_Syntactic_Mismatch; + Check_For_Syntactic_Field_Mismatch; Verify_Type_Table; @@ -2970,23 +3235,33 @@ package body Gen_IL.Gen is end Compile; + -------- + -- Sy -- + -------- + function Sy (Field : Node_Field; Field_Type : Type_Enum; Default_Value : Field_Default_Value := No_Default; - Pre : String := "") return Field_Sequence is + Pre, Pre_Get, Pre_Set : String := "") return Field_Sequence is begin return - (1 => Create_Syntactic_Field (Field, Field_Type, Default_Value, Pre)); + (1 => Create_Syntactic_Field + (Field, Field_Type, Default_Value, Pre, Pre_Get, Pre_Set)); end Sy; + -------- + -- Sm -- + -------- + function Sm (Field : Field_Enum; Field_Type : Type_Enum; Type_Only : Type_Only_Enum := No_Type_Only; - Pre : String := "") return Field_Sequence is + Pre, Pre_Get, Pre_Set : String := "") return Field_Sequence is begin - return (1 => Create_Semantic_Field (Field, Field_Type, Type_Only, Pre)); + return (1 => Create_Semantic_Field + (Field, Field_Type, Type_Only, Pre, Pre_Get, Pre_Set)); end Sm; end Gen_IL.Gen; diff --git a/gcc/ada/gen_il-gen.ads b/gcc/ada/gen_il-gen.ads index 2319086e1f0..34ce2d6081e 100644 --- a/gcc/ada/gen_il-gen.ads +++ b/gcc/ada/gen_il-gen.ads @@ -23,104 +23,121 @@ -- -- ------------------------------------------------------------------------------ +-- "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. + 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; +with Gen_IL.Internals; use Gen_IL.Internals; +use Gen_IL.Internals.Type_Vectors; +use Gen_IL.Internals.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; + -- Create the root node type (Node_Kind), which is an abstract type + procedure Create_Abstract_Node_Type (T : Abstract_Node; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields); + -- Create an abstract node type (other than the root node type) + procedure Create_Concrete_Node_Type (T : Concrete_Node; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields); + -- Create a concrete node type. Every node is an instance of a concrete + -- node type. + procedure Create_Root_Entity_Type (T : Abstract_Entity; Fields : Field_Sequence := No_Fields) with Pre => T = Entity_Kind; + -- Create the root entity type (Entity_Kind), which is an abstract type + procedure Create_Abstract_Entity_Type (T : Abstract_Entity; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields); + -- Create an abstract entity type (other than the root entity type) + procedure Create_Concrete_Entity_Type (T : Concrete_Entity; Parent : Abstract_Type; Fields : Field_Sequence := No_Fields); + -- Create a concrete entity type. Every entity is an instance of a concrete + -- entity type. function Create_Syntactic_Field (Field : Node_Field; Field_Type : Type_Enum; Default_Value : Field_Default_Value := No_Default; - Pre : String := "") return Field_Desc; + Pre, Pre_Get, Pre_Set : String := "") return Field_Desc; + -- Create a syntactic field of a node type. Entities do not have syntactic + -- fields. + function Create_Semantic_Field (Field : Field_Enum; Field_Type : Type_Enum; Type_Only : Type_Only_Enum := No_Type_Only; - Pre : String := "") return Field_Desc; + Pre, Pre_Get, Pre_Set : String := "") return Field_Desc; + -- Create a semantic field of a node or entity type + -- 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. @@ -134,7 +151,9 @@ package Gen_IL.Gen is -- 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. + -- to the precondition that asserts that the type has that field. Pre_Get + -- and Pre_Set are similar to Pre, but for the getter or setter only, + -- respectively. -- -- 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 @@ -160,7 +179,7 @@ package Gen_IL.Gen is -- -- If a type or field name does not follow the usual Mixed_Case convention, -- such as "SPARK_Pragma", then you have to add a special case to one of - -- the Image functions in Gen_IL.Utils. + -- the Image functions in Gen_IL.Internals and in Treepr. -- Forward references are not allowed. So if you say: -- @@ -176,8 +195,8 @@ package Gen_IL.Gen is -- (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 + -- subranges in Gen_IL.Internals 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 @@ -185,8 +204,10 @@ package Gen_IL.Gen is -- 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); + procedure Create_Node_Union_Type + (T : Abstract_Node; Children : Type_Array); + procedure Create_Entity_Union_Type + (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 @@ -211,12 +232,12 @@ private (Field : Node_Field; Field_Type : Type_Enum; Default_Value : Field_Default_Value := No_Default; - Pre : String := "") return Field_Sequence; + Pre, Pre_Get, Pre_Set : 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; + Pre, Pre_Get, Pre_Set : 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: @@ -225,6 +246,7 @@ private -- (Sy (Chars, Name_Id, Default_No_Name))); -- -- where that thing pretending to be an aggregate is really a parenthesized - -- expression. + -- expression. See Gen_Nodes for documentation of the functions these are + -- standing in for. end Gen_IL.Gen; diff --git a/gcc/ada/gen_il-utils.adb b/gcc/ada/gen_il-internals.adb similarity index 88% rename from gcc/ada/gen_il-utils.adb rename to gcc/ada/gen_il-internals.adb index 21acd9bfe25..ca6c217c163 100644 --- a/gcc/ada/gen_il-utils.adb +++ b/gcc/ada/gen_il-internals.adb @@ -23,13 +23,21 @@ -- -- ------------------------------------------------------------------------------ -package body Gen_IL.Utils is +package body Gen_IL.Internals is + + --------- + -- Nil -- + --------- procedure Nil (T : Node_Or_Entity_Type) is begin null; end Nil; + -------------------- + -- Node_Or_Entity -- + -------------------- + function Node_Or_Entity (Root : Root_Type) return String is begin if Root = Node_Kind then @@ -39,6 +47,10 @@ package body Gen_IL.Utils is end if; end Node_Or_Entity; + ------------------------------ + -- Num_Concrete_Descendants -- + ------------------------------ + function Num_Concrete_Descendants (T : Node_Or_Entity_Type) return Natural is begin @@ -72,7 +84,10 @@ package body Gen_IL.Utils is (case Root is when Node_Kind => Node_Field'Last, when others => Entity_Field'Last); -- Entity_Kind - -- First and Last node or entity fields + + ----------------------- + -- Verify_Type_Table -- + ----------------------- procedure Verify_Type_Table is begin @@ -88,7 +103,7 @@ package body Gen_IL.Utils is pragma Assert (Type_Table (T).First < Type_Table (T).Last); - when Boundaries => + when Type_Boundaries => null; end case; end if; @@ -96,6 +111,10 @@ package body Gen_IL.Utils is end loop; end Verify_Type_Table; + -------------- + -- Id_Image -- + -------------- + function Id_Image (T : Type_Enum) return String is begin case T is @@ -105,15 +124,19 @@ package body Gen_IL.Utils is return "Node_Id"; when Entity_Kind => return "Entity_Id"; - when Nkind_Type => + when Node_Kind_Type => return "Node_Kind"; - when Ekind_Type => + when Entity_Kind_Type => return "Entity_Kind"; when others => return Image (T) & "_Id"; end case; end Id_Image; + ---------------------- + -- Get_Set_Id_Image -- + ---------------------- + function Get_Set_Id_Image (T : Type_Enum) return String is begin case T is @@ -121,15 +144,19 @@ package body Gen_IL.Utils is return "Node_Id"; when Entity_Kind => return "Entity_Id"; - when Nkind_Type => + when Node_Kind_Type => return "Node_Kind"; - when Ekind_Type => + when Entity_Kind_Type => return "Entity_Kind"; when others => return Image (T); end case; end Get_Set_Id_Image; + ----------- + -- Image -- + ----------- + function Image (T : Opt_Type_Enum) return String is begin case T is @@ -165,6 +192,10 @@ package body Gen_IL.Utils is end case; end Image; + ------------------ + -- Image_Sans_N -- + ------------------ + function Image_Sans_N (T : Opt_Type_Enum) return String is Im : constant String := Image (T); pragma Assert (Im (1 .. 2) = "N_"); @@ -172,7 +203,11 @@ package body Gen_IL.Utils is return Im (3 .. Im'Last); end Image_Sans_N; - procedure Put_Images (S : in out Sink'Class; U : Type_Vector) is + ------------------------- + -- Put_Types_With_Bars -- + ------------------------- + + procedure Put_Types_With_Bars (S : in out Sink'Class; U : Type_Vector) is First_Time : Boolean := True; begin Indent (S, 3); @@ -188,9 +223,13 @@ package body Gen_IL.Utils is end loop; Outdent (S, 3); - end Put_Images; + end Put_Types_With_Bars; + + ---------------------------- + -- Put_Type_Ids_With_Bars -- + ---------------------------- - procedure Put_Id_Images (S : in out Sink'Class; U : Type_Vector) is + procedure Put_Type_Ids_With_Bars (S : in out Sink'Class; U : Type_Vector) is First_Time : Boolean := True; begin Indent (S, 3); @@ -206,7 +245,11 @@ package body Gen_IL.Utils is end loop; Outdent (S, 3); - end Put_Id_Images; + end Put_Type_Ids_With_Bars; + + ----------- + -- Image -- + ----------- function Image (F : Opt_Field_Enum) return String is begin @@ -315,6 +358,10 @@ package body Gen_IL.Utils is function Image (Default : Field_Default_Value) return String is (Capitalize (Default'Img)); + ----------------- + -- Value_Image -- + ----------------- + function Value_Image (Default : Field_Default_Value) return String is begin if Default = No_Default then @@ -333,6 +380,10 @@ package body Gen_IL.Utils is end if; end Value_Image; + ------------------- + -- Iterate_Types -- + ------------------- + procedure Iterate_Types (Root : Node_Or_Entity_Type; Pre, Post : not null access procedure (T : Node_Or_Entity_Type) := @@ -356,6 +407,10 @@ package body Gen_IL.Utils is Recursive (Root); end Iterate_Types; + ------------------- + -- Is_Descendant -- + ------------------- + function Is_Descendant (Ancestor, Descendant : Node_Or_Entity_Type) return Boolean is begin @@ -370,6 +425,10 @@ package body Gen_IL.Utils is end if; end Is_Descendant; + ------------------------ + -- Put_Type_Hierarchy -- + ------------------------ + procedure Put_Type_Hierarchy (S : in out Sink'Class; Root : Root_Type) is Level : Natural := 0; @@ -383,10 +442,7 @@ package body Gen_IL.Utils is 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; - + Put (S, "-- \1\2\n", Indentation, Image (T)); Level := Level + 1; end Pre; @@ -394,13 +450,11 @@ package body Gen_IL.Utils 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". + -- 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; + if Num_Concrete_Descendants (T) > 10 then + Put (S, "-- \1end \2\n", Indentation, Image (T)); end if; end Post; @@ -409,6 +463,8 @@ package body Gen_IL.Utils is when Node_Kind => "nodes", when others => "entities"); -- Entity_Kind + -- Start of processing for Put_Type_Hierarchy + begin Put (S, "-- Type hierarchy for \1\n", N_Or_E); Put (S, "--\n"); @@ -419,6 +475,10 @@ package body Gen_IL.Utils is Put (S, "-- End type hierarchy for \1\n\n", N_Or_E); end Put_Type_Hierarchy; + --------- + -- Pos -- + --------- + function Pos (T : Concrete_Type) return Root_Nat is First : constant Concrete_Type := (if T in Concrete_Node then Concrete_Node'First @@ -450,4 +510,4 @@ package body Gen_IL.Utils is end Pfields; pragma Warnings (On); -end Gen_IL.Utils; +end Gen_IL.Internals; diff --git a/gcc/ada/gen_il-internals.ads b/gcc/ada/gen_il-internals.ads new file mode 100644 index 00000000000..93acdb47e68 --- /dev/null +++ b/gcc/ada/gen_il-internals.ads @@ -0,0 +1,255 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 GNAT.Strings; use GNAT.Strings; + +with Gen_IL.Types; use Gen_IL.Types; +with Gen_IL.Fields; use Gen_IL.Fields; + +package Gen_IL.Internals is + + 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_" + + ---------------- + + 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; + + ---------------- + + procedure Put_Types_With_Bars (S : in out Sink'Class; U : Type_Vector); + procedure Put_Type_Ids_With_Bars (S : in out Sink'Class; U : Type_Vector); + -- 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; + -- Image of the type for use with _Id types + + function Get_Set_Id_Image (T : Type_Enum) return String; + -- Image of the type for use with getters and setters + + ---------------- + + 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; + package Field_Vectors is new Vectors (Field_Index, Field_Enum); + subtype Field_Vector is Field_Vectors.Vector; + procedure Pfields (V : Field_Vector); -- for debugging + + type Bit_Offset is new Root_Nat range 0 .. 32_000 - 1; + -- Offset in bits. The number 32_000 is chosen because there are fewer than + -- 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; + 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. + + procedure Verify_Type_Table; + -- Check Type_Table for consistency + + 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. + + function Image (Default : Field_Default_Value) return String; + -- This will be something like "Default_Empty". + function Value_Image (Default : Field_Default_Value) return String; + -- This will be something like "Empty". + + 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 documented in einfo.ads. + -- The default is No_Type_Only, indicating the field is not one of + -- these special "[... only]" ones. + + type Field_Info is record + Have_This_Field : Type_Vector; + -- Types that have this field + + 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, Pre_Get, Pre_Set : String_Access; + -- Above record the information in the calls to Create_...Field. + -- See Gen_IL.Gen for details. + + Offset : Field_Offset; + -- Offset of the field from the start of the node, in units of the field + -- size. So if a field is 4 bits in size, 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. + + ---------------- + + 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) + + ---------------- + + type Field_Desc is record + F : Field_Enum; + Is_Syntactic : Boolean; + -- The same field can be syntactic in some nodes but semantic in others + 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 Concrete_Type_Layout_Array is array (Concrete_Type) of Field_Array_Ptr; + -- Mapping from types to mappings from offsets to fields. Each bit offset + -- is mapped to the corresponding field for the given type. An n-bit field + -- will have n bit offsets mapped to the same field. + + 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. So for example if + -- Root = Node_Kind, then First_Abstract = Abstract_Node'First. + + 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 or + -- Entity_Kind. + +end Gen_IL.Internals; diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads index 684d2bfb2c8..6d0af217e85 100644 --- a/gcc/ada/gen_il-types.ads +++ b/gcc/ada/gen_il-types.ads @@ -27,17 +27,20 @@ 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). + -- and every type that can be the type of a field. -- 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. + -- (declared below) plus the special null value No_Type. See the spec of + -- Gen_IL.Gen for how to modify this. (Of course, in Ada we have to define + -- this backwards from the above conceptual description.) + + -- Note that there are various subranges of this type declared below, + -- which might need to be kept in sync when modifying this. + + -- The "Between_..." literals below are simply for making the 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 + -- (Abstract_Node, Abstract_Entity, Concrete_Node, Concrete_Entity). type Opt_Type_Enum is (No_Type, @@ -54,8 +57,8 @@ package Gen_IL.Types is 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 + Node_Kind_Type, -- Type of result of Nkind function, i.e. Node_Kind + Entity_Kind_Type, -- Type of result of Ekind function, i.e. Entity_Kind Source_Ptr, Small_Paren_Count_Type, Union_Id, @@ -146,6 +149,7 @@ package Gen_IL.Types is Incomplete_Or_Private_Kind, Integer_Kind, Modular_Integer_Kind, + Named_Access_Kind, Named_Kind, Numeric_Kind, Object_Kind, @@ -493,4 +497,72 @@ package Gen_IL.Types is ); -- Type_Enum + 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 Traversed_Field_Type is Type_Enum with Predicate => + Traversed_Field_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; + + subtype Opt_Abstract_Type is Opt_Type_Enum with + Predicate => Opt_Abstract_Type = No_Type or + Opt_Abstract_Type in Abstract_Type; + + subtype Type_Boundaries is Type_Enum with + Predicate => Type_Boundaries in + Between_Abstract_Node_And_Abstract_Entity_Types | + Between_Abstract_Entity_And_Concrete_Node_Types | + Between_Concrete_Node_And_Concrete_Entity_Types; + -- These are not used, other than to separate the various subranges. + end Gen_IL.Types; diff --git a/gcc/ada/gen_il-utils.ads b/gcc/ada/gen_il-utils.ads deleted file mode 100644 index f264a5f5650..00000000000 --- a/gcc/ada/gen_il-utils.ads +++ /dev/null @@ -1,558 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G E N _ I L . U T I L S -- --- -- --- S p e c -- --- -- --- Copyright (C) 2020-2021, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Ada.Containers.Vectors; use Ada.Containers; - -with Gen_IL.Types; use Gen_IL.Types; -with Gen_IL.Fields; use Gen_IL.Fields; - -package Gen_IL.Utils is - - subtype Type_Enum is Opt_Type_Enum - range Opt_Type_Enum'Succ (No_Type) .. Opt_Type_Enum'Last; - -- Enumeration of types -- Opt_Type_Enum without the special null value - -- No_Type. - - subtype Node_Or_Entity_Type is - Type_Enum range - Type_Enum'Succ (Between_Special_And_Abstract_Node_Types) .. - Type_Enum'Last; - - subtype Abstract_Type is - Type_Enum range - Type_Enum'Succ (Between_Special_And_Abstract_Node_Types) .. - Type_Enum'Pred (Between_Abstract_Entity_And_Concrete_Node_Types); - subtype Abstract_Node is - Abstract_Type range - Type_Enum'Succ (Between_Special_And_Abstract_Node_Types) .. - Type_Enum'Pred (Between_Abstract_Node_And_Abstract_Entity_Types); - subtype Abstract_Entity is - Abstract_Type range - Type_Enum'Succ (Between_Abstract_Node_And_Abstract_Entity_Types) .. - Type_Enum'Pred (Between_Abstract_Entity_And_Concrete_Node_Types); - - subtype Concrete_Type is - Type_Enum range - Type_Enum'Succ (Between_Abstract_Entity_And_Concrete_Node_Types) .. - Type_Enum'Last; - subtype Concrete_Node is - Concrete_Type range - Type_Enum'Succ (Between_Abstract_Entity_And_Concrete_Node_Types) .. - Type_Enum'Pred (Between_Concrete_Node_And_Concrete_Entity_Types); - subtype Concrete_Entity is - Concrete_Type range - Type_Enum'Succ (Between_Concrete_Node_And_Concrete_Entity_Types) .. - Type_Enum'Last; - - subtype Root_Type is Abstract_Type with - Predicate => Root_Type in Node_Kind | Entity_Kind; - - subtype Node_Type is Node_Or_Entity_Type with - Predicate => Node_Type in Abstract_Node | Concrete_Node; - subtype Entity_Type is Node_Or_Entity_Type with - Predicate => Entity_Type in Abstract_Entity | Concrete_Entity; - - subtype Special_Type is Type_Enum range - Flag .. Type_Enum'Pred (Between_Special_And_Abstract_Node_Types); - - subtype Traversal_Type is Type_Enum with Predicate => - Traversal_Type in Node_Id | List_Id | Node_Type; - -- These are the types of fields traversed by Traverse_Func - - subtype Entity_Node is Node_Type with - Predicate => Entity_Node in - N_Defining_Character_Literal - | N_Defining_Identifier - | N_Defining_Operator_Symbol; - - function Image (T : Opt_Type_Enum) return String; - - function Image_Sans_N (T : Opt_Type_Enum) return String; - -- Returns the image without the leading "N_" - - subtype Boundaries is Type_Enum with - Predicate => Boundaries in - Between_Abstract_Node_And_Abstract_Entity_Types | - Between_Abstract_Entity_And_Concrete_Node_Types | - Between_Concrete_Node_And_Concrete_Entity_Types; - - ---------------- - - type Type_Set is array (Type_Enum) of Boolean; - - type Type_Index is new Positive; - subtype Type_Count is Type_Index'Base range 0 .. Type_Index'Last; - package Type_Vectors is new Vectors (Type_Index, Type_Enum); - use Type_Vectors; - subtype Type_Vector is Type_Vectors.Vector; - - procedure Ptypes (V : Type_Vector); -- for debugging - - type Type_Array is array (Type_Index range <>) of Type_Enum; - - subtype Field_Enum is Opt_Field_Enum - range Opt_Field_Enum'Succ (No_Field) .. Opt_Field_Enum'Last; - -- Enumeration of fields -- Opt_Field_Enum without the special null value - -- No_Field. - - subtype Node_Header_Type is Type_Enum range - Nkind_Type .. Union_Id; - subtype Node_Header_Field is Field_Enum with Predicate => - Node_Header_Field in Nkind .. Link | Ekind; - - type Fields_Present_Array is array (Field_Enum) of Type_Set; - - type Field_Set is array (Field_Enum) of Boolean; - type Fields_Per_Node_Type is array (Node_Or_Entity_Type) of Field_Set; - - type Field_Index is new Positive; - subtype Field_Count is Field_Index'Base range 0 .. Field_Index'Last; - package Field_Vectors is new Vectors (Field_Index, Field_Enum); - subtype Field_Vector is Field_Vectors.Vector; - procedure Pfields (V : Field_Vector); -- for debugging - - subtype Opt_Abstract_Type is Opt_Type_Enum with - Predicate => Opt_Abstract_Type = No_Type or - Opt_Abstract_Type in Abstract_Type; - - procedure Put_Images (S : in out Sink'Class; U : Type_Vector); - procedure Put_Id_Images (S : in out Sink'Class; U : Type_Vector); - -- Put the types with vertical bars in between, as in - -- N_This | N_That | N_Other - -- or - -- N_This_Id | N_That_Id | N_Other_Id - - function Id_Image (T : Type_Enum) return String; - function Get_Set_Id_Image (T : Type_Enum) return String; - - type Bit_Offset is new Root_Nat range 0 .. 32_000 - 1; - -- There are fewer than 1000 fields. But offsets are in size units (1 bit - -- for flags, 32 bits for most others, also 2, 4, and 8). - - type Field_Offset is new Bit_Offset; - - type Type_Info (Is_Union : Boolean) is record - Parent : Opt_Abstract_Type; - -- Parent of this type (single inheritance). No_Type for a root - -- type (Node_Kind or Entity_Kind). For union types, this is - -- a root type. - - Children : Type_Vector; - -- Inverse of Parent - - Concrete_Descendants : Type_Vector; - - case Is_Union is - when True => - null; - - when False => - First, Last : Concrete_Type; - -- This type includes concrete types in the range First..Last. For - -- a concrete type, First=Last. For an abstract type, First..Last - -- includes two or more types. - - Fields : Field_Vector; - - Allow_Overlap : Boolean; - -- True to allow overlapping subranges - end case; - end record; - - type Type_Info_Ptr is access all Type_Info; - - Type_Table : array (Node_Or_Entity_Type) of Type_Info_Ptr; - -- Table mapping from enumeration literals representing types to - -- information about the type. - - function Num_Concrete_Descendants - (T : Node_Or_Entity_Type) return Natural; - -- Number of concrete descendants of T, including (if T is concrete) - -- itself. - - type Field_Default_Value is - (No_Default, - Default_Empty, -- Node_Id - Default_No_List, Default_Empty_List, -- List_Id - Default_False, Default_True, -- Flag - Default_No_Elist, -- Elist_Id - Default_No_Name, -- Name_Id - Default_Uint_0); -- Uint - -- Default value for a field in the Nmake functions. No_Default if the - -- field parameter has no default value. Otherwise this indicates the - -- default value used, which must matcht the type of the field. - - type Type_Only_Enum is - (No_Type_Only, Base_Type_Only, Impl_Base_Type_Only, Root_Type_Only); - -- ????These correspond to the "[base type only]", "[implementation base - -- type only]", and "[root type only]" annotations in the old einfo.ads. - -- Move the relevant comments here. There is no comment explaining - -- [root type only] in the old einfo.ads. - - function Image (Default : Field_Default_Value) return String; - function Value_Image (Default : Field_Default_Value) return String; - - type Field_Info is record - Have_This_Field : Type_Vector; - - Field_Type : Type_Enum; - -- Type of the field. Currently, we use Node_Id for all node-valued - -- fields, but we could narrow down to children of that. Similar for - -- Entity_Id. - - Default_Value : Field_Default_Value; - Type_Only : Type_Only_Enum; - Pre : String_Ptr; - - Offset : Field_Offset; - -- Offset of the field, in units of the field size. So if a field is 4 - -- bits, it starts at bit number Offset*4 from the start of the node. - end record; - - type Field_Info_Ptr is access all Field_Info; - - Field_Table : array (Field_Enum) of Field_Info_Ptr; - -- Table mapping from enumeration literals representing fields to - -- information about the field. - - procedure Verify_Type_Table; - - ---------------- - - subtype Node_Field is - Field_Enum range - Field_Enum'First .. - Field_Enum'Pred (Between_Node_And_Entity_Fields); - - subtype Entity_Field is - Field_Enum range - Field_Enum'Succ (Between_Node_And_Entity_Fields) .. - Field_Enum'Last; - - function Image (F : Opt_Field_Enum) return String; - - procedure Nil (T : Node_Or_Entity_Type); - -- Null procedure - - procedure Iterate_Types - (Root : Node_Or_Entity_Type; - Pre, Post : not null access procedure (T : Node_Or_Entity_Type) := - Nil'Access); - -- Iterate top-down on the type hierarchy. Call Pre and Post before and - -- after walking child types. Note that this ignores union types, because - -- they are nonhierarchical. - - function Is_Descendant (Ancestor, Descendant : Node_Or_Entity_Type) - return Boolean; - -- True if Descendant is a descendant of Ancestor; that is, - -- True if Ancestor is an ancestor of Descendant. True for - -- a type itself. - - procedure Put_Type_Hierarchy (S : in out Sink'Class; Root : Root_Type); - - function Pos (T : Concrete_Type) return Root_Nat; - -- Return Node_Kind'Pos (T) or Entity_Kind'Pos (T) - - ---------------- - - -- The same field can be syntactic in some nodes but semantic in others: - - type Field_Desc is record - F : Field_Enum; - Is_Syntactic : Boolean; - end record; - - type Field_Sequence_Index is new Positive; - type Field_Sequence is array (Field_Sequence_Index range <>) of Field_Desc; - No_Fields : constant Field_Sequence := (1 .. 0 => <>); - - type Field_Array is array (Bit_Offset range <>) of Opt_Field_Enum; - type Field_Array_Ptr is access all Field_Array; - - type Type_Layout_Array is array (Concrete_Type) of Field_Array_Ptr; - -- Mapping from types to mappings from offsets to fields - - type Offset_To_Fields_Mapping is - array (Bit_Offset range <>) of Field_Array_Ptr; - -- Mapping from bit offsets to fields using that offset - - function First_Abstract (Root : Root_Type) return Abstract_Type; - function Last_Abstract (Root : Root_Type) return Abstract_Type; - -- First and Last abstract types descended from the Root - - function First_Concrete (Root : Root_Type) return Concrete_Type; - function Last_Concrete (Root : Root_Type) return Concrete_Type; - -- First and Last concrete types descended from the Root - - function First_Field (Root : Root_Type) return Field_Enum; - function Last_Field (Root : Root_Type) return Field_Enum; - -- First and Last node or entity fields - - function Node_Or_Entity (Root : Root_Type) return String; - -- Return "Node" or "Entity" depending on whether Root = Node_Kind - - type Sinfo_Node_Order_Index is new Positive; - Sinfo_Node_Order : - constant array (Sinfo_Node_Order_Index range <>) of Node_Type := - -- The order in which the documentation of node kinds appears in the old - -- sinfo.ads. This is the same order of the functions in Nmake. - -- Sinfo_Node_Order was constructed by massaging nmake.ads. - (N_Unused_At_Start, - N_Unused_At_End, - N_Identifier, - N_Integer_Literal, - N_Real_Literal, - N_Character_Literal, - N_String_Literal, - N_Pragma, - N_Pragma_Argument_Association, - N_Defining_Identifier, - N_Full_Type_Declaration, - N_Subtype_Declaration, - N_Subtype_Indication, - N_Object_Declaration, - N_Number_Declaration, - N_Derived_Type_Definition, - N_Range_Constraint, - N_Range, - N_Enumeration_Type_Definition, - N_Defining_Character_Literal, - N_Signed_Integer_Type_Definition, - N_Modular_Type_Definition, - N_Floating_Point_Definition, - N_Real_Range_Specification, - N_Ordinary_Fixed_Point_Definition, - N_Decimal_Fixed_Point_Definition, - N_Digits_Constraint, - N_Unconstrained_Array_Definition, - N_Constrained_Array_Definition, - N_Component_Definition, - N_Discriminant_Specification, - N_Index_Or_Discriminant_Constraint, - N_Discriminant_Association, - N_Record_Definition, - N_Component_List, - N_Component_Declaration, - N_Variant_Part, - N_Variant, - N_Others_Choice, - N_Access_To_Object_Definition, - N_Access_Function_Definition, - N_Access_Procedure_Definition, - N_Access_Definition, - N_Incomplete_Type_Declaration, - N_Explicit_Dereference, - N_Indexed_Component, - N_Slice, - N_Selected_Component, - N_Attribute_Reference, - N_Aggregate, - N_Component_Association, - N_Extension_Aggregate, - N_Iterated_Component_Association, - N_Delta_Aggregate, - N_Iterated_Element_Association, - N_Null, - N_And_Then, - N_Or_Else, - N_In, - N_Not_In, - N_Op_And, - N_Op_Or, - N_Op_Xor, - N_Op_Eq, - N_Op_Ne, - N_Op_Lt, - N_Op_Le, - N_Op_Gt, - N_Op_Ge, - N_Op_Add, - N_Op_Subtract, - N_Op_Concat, - N_Op_Multiply, - N_Op_Divide, - N_Op_Mod, - N_Op_Rem, - N_Op_Expon, - N_Op_Plus, - N_Op_Minus, - N_Op_Abs, - N_Op_Not, - N_If_Expression, - N_Case_Expression, - N_Case_Expression_Alternative, - N_Quantified_Expression, - N_Type_Conversion, - N_Qualified_Expression, - N_Allocator, - N_Null_Statement, - N_Label, - N_Assignment_Statement, - N_Target_Name, - N_If_Statement, - N_Elsif_Part, - N_Case_Statement, - N_Case_Statement_Alternative, - N_Loop_Statement, - N_Iteration_Scheme, - N_Loop_Parameter_Specification, - N_Iterator_Specification, - N_Block_Statement, - N_Exit_Statement, - N_Goto_Statement, - N_Subprogram_Declaration, - N_Abstract_Subprogram_Declaration, - N_Function_Specification, - N_Procedure_Specification, - N_Designator, - N_Defining_Program_Unit_Name, - N_Operator_Symbol, - N_Defining_Operator_Symbol, - N_Parameter_Specification, - N_Subprogram_Body, - N_Procedure_Call_Statement, - N_Function_Call, - N_Parameter_Association, - N_Simple_Return_Statement, - N_Extended_Return_Statement, - N_Expression_Function, - N_Package_Declaration, - N_Package_Specification, - N_Package_Body, - N_Private_Type_Declaration, - N_Private_Extension_Declaration, - N_Use_Package_Clause, - N_Use_Type_Clause, - N_Object_Renaming_Declaration, - N_Exception_Renaming_Declaration, - N_Package_Renaming_Declaration, - N_Subprogram_Renaming_Declaration, - N_Generic_Package_Renaming_Declaration, - N_Generic_Procedure_Renaming_Declaration, - N_Generic_Function_Renaming_Declaration, - N_Task_Type_Declaration, - N_Single_Task_Declaration, - N_Task_Definition, - N_Task_Body, - N_Protected_Type_Declaration, - N_Single_Protected_Declaration, - N_Protected_Definition, - N_Protected_Body, - N_Entry_Declaration, - N_Accept_Statement, - N_Entry_Body, - N_Entry_Body_Formal_Part, - N_Entry_Index_Specification, - N_Entry_Call_Statement, - N_Requeue_Statement, - N_Delay_Until_Statement, - N_Delay_Relative_Statement, - N_Selective_Accept, - N_Accept_Alternative, - N_Delay_Alternative, - N_Terminate_Alternative, - N_Timed_Entry_Call, - N_Entry_Call_Alternative, - N_Conditional_Entry_Call, - N_Asynchronous_Select, - N_Triggering_Alternative, - N_Abortable_Part, - N_Abort_Statement, - N_Compilation_Unit, - N_Compilation_Unit_Aux, - N_With_Clause, - N_Subprogram_Body_Stub, - N_Package_Body_Stub, - N_Task_Body_Stub, - N_Protected_Body_Stub, - N_Subunit, - N_Exception_Declaration, - N_Handled_Sequence_Of_Statements, - N_Exception_Handler, - N_Raise_Statement, - N_Raise_Expression, - N_Generic_Subprogram_Declaration, - N_Generic_Package_Declaration, - N_Package_Instantiation, - N_Procedure_Instantiation, - N_Function_Instantiation, - N_Generic_Association, - N_Formal_Object_Declaration, - N_Formal_Type_Declaration, - N_Formal_Private_Type_Definition, - N_Formal_Derived_Type_Definition, - N_Formal_Incomplete_Type_Definition, - N_Formal_Discrete_Type_Definition, - N_Formal_Signed_Integer_Type_Definition, - N_Formal_Modular_Type_Definition, - N_Formal_Floating_Point_Definition, - N_Formal_Ordinary_Fixed_Point_Definition, - N_Formal_Decimal_Fixed_Point_Definition, - N_Formal_Concrete_Subprogram_Declaration, - N_Formal_Abstract_Subprogram_Declaration, - N_Formal_Package_Declaration, - N_Attribute_Definition_Clause, - N_Aspect_Specification, - N_Enumeration_Representation_Clause, - N_Record_Representation_Clause, - N_Component_Clause, - N_Code_Statement, - N_Op_Rotate_Left, - N_Op_Rotate_Right, - N_Op_Shift_Left, - N_Op_Shift_Right_Arithmetic, - N_Op_Shift_Right, - N_Delta_Constraint, - N_At_Clause, - N_Mod_Clause, - N_Call_Marker, - N_Compound_Statement, - N_Contract, - N_Expanded_Name, - N_Expression_With_Actions, - N_Free_Statement, - N_Freeze_Entity, - N_Freeze_Generic_Entity, - N_Implicit_Label_Declaration, - N_Itype_Reference, - N_Raise_Constraint_Error, - N_Raise_Program_Error, - N_Raise_Storage_Error, - N_Push_Constraint_Error_Label, - N_Push_Program_Error_Label, - N_Push_Storage_Error_Label, - N_Pop_Constraint_Error_Label, - N_Pop_Program_Error_Label, - N_Pop_Storage_Error_Label, - N_Reference, - N_SCIL_Dispatch_Table_Tag_Init, - N_SCIL_Dispatching_Call, - N_SCIL_Membership_Test, - N_Unchecked_Expression, - N_Unchecked_Type_Conversion, - N_Validate_Unchecked_Conversion, - N_Variable_Reference_Marker); - -end Gen_IL.Utils; diff --git a/gcc/ada/gen_il.adb b/gcc/ada/gen_il.adb index 1a6326daa6c..7114c7c6c2e 100644 --- a/gcc/ada/gen_il.adb +++ b/gcc/ada/gen_il.adb @@ -25,6 +25,10 @@ package body Gen_IL is + ----------- + -- Image -- + ----------- + function Image (X : Root_Int) return String is Result : constant String := X'Img; begin @@ -35,6 +39,10 @@ package body Gen_IL is end if; end Image; + ---------------- + -- Capitalize -- + ---------------- + procedure Capitalize (S : in out String) is Cap : Boolean := True; begin @@ -53,6 +61,10 @@ package body Gen_IL is end loop; end Capitalize; + ---------------- + -- Capitalize -- + ---------------- + function Capitalize (S : String) return String is begin return Result : String (S'Range) := S do diff --git a/gcc/ada/gen_il.ads b/gcc/ada/gen_il.ads index 3b0e4ba9af1..6a86ed6d610 100644 --- a/gcc/ada/gen_il.ads +++ b/gcc/ada/gen_il.ads @@ -34,260 +34,32 @@ 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. + -- by the GNAT 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. + -- The generated Ada packages are: + -- + -- Seinfo + -- Sinfo.Nodes + -- Einfo.Entities + -- Nmake + -- Seinfo_Tables + -- + -- We also generate C code: + -- + -- einfo.h + -- sinfo.h + -- snames.h + -- + -- It is necessary to look at this generated code in order to understand + -- the compiler. In addition, it is necessary to look at comments in the + -- spec and body of Gen_IL. + -- + -- Note that the Gen_IL "compiler" and the GNAT Ada compiler are separate + -- programs, with no dependencies between them in either direction. That + -- is, Gen_IL does not say "with" of GNAT units, and GNAT does not say + -- "with Gen_IL". [...] [diff truncated at 524288 bytes]