diff options
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 238 |
1 files changed, 116 insertions, 122 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 593e6f8..b13af26 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11978,163 +11978,157 @@ package body Sem_Ch13 is Sbit : Uint; Abit : out Uint) is - Compl : Integer; + Compl : constant Natural := + Natural (List_Length (Component_Items (CL)) + List_Length (DS)); - begin - Compl := Integer (List_Length (Component_Items (CL))); - - if DS /= No_List then - Compl := Compl + Integer (List_Length (DS)); - end if; - - declare - Comps : array (Natural range 0 .. Compl) of Entity_Id; - -- Gather components (zero entry is for sort routine) + Comps : array (Natural range 0 .. Compl) of Entity_Id; + -- Gather components (zero entry is for sort routine) - Ncomps : Natural := 0; - -- Number of entries stored in Comps (starting at Comps (1)) + Ncomps : Natural := 0; + -- Number of entries stored in Comps (starting at Comps (1)) - Citem : Node_Id; - -- One component item or discriminant specification + Citem : Node_Id; + -- One component item or discriminant specification - Nbit : Uint; - -- Starting bit for next component + Nbit : Uint; + -- Starting bit for next component - CEnt : Entity_Id; - -- Component entity + CEnt : Entity_Id; + -- Component entity - Variant : Node_Id; - -- One variant + Variant : Node_Id; + -- One variant - function Lt (Op1, Op2 : Natural) return Boolean; - -- Compare routine for Sort + function Lt (Op1, Op2 : Natural) return Boolean; + -- Compare routine for Sort - procedure Move (From : Natural; To : Natural); - -- Move routine for Sort + procedure Move (From : Natural; To : Natural); + -- Move routine for Sort - package Sorting is new GNAT.Heap_Sort_G (Move, Lt); + package Sorting is new GNAT.Heap_Sort_G (Move, Lt); - -------- - -- Lt -- - -------- + -------- + -- Lt -- + -------- - function Lt (Op1, Op2 : Natural) return Boolean is - K1 : constant Boolean := - Known_Component_Bit_Offset (Comps (Op1)); - K2 : constant Boolean := - Known_Component_Bit_Offset (Comps (Op2)); - -- Record representation clauses can be incomplete, so the - -- Component_Bit_Offsets can be unknown. - begin - if K1 then - if K2 then - return Component_Bit_Offset (Comps (Op1)) - < Component_Bit_Offset (Comps (Op2)); - else - return True; - end if; + function Lt (Op1, Op2 : Natural) return Boolean is + K1 : constant Boolean := + Known_Component_Bit_Offset (Comps (Op1)); + K2 : constant Boolean := + Known_Component_Bit_Offset (Comps (Op2)); + -- Record representation clauses can be incomplete, so the + -- Component_Bit_Offsets can be unknown. + begin + if K1 then + if K2 then + return Component_Bit_Offset (Comps (Op1)) + < Component_Bit_Offset (Comps (Op2)); else - return K2; + return True; end if; - end Lt; + else + return K2; + end if; + end Lt; - ---------- - -- Move -- - ---------- - - procedure Move (From : Natural; To : Natural) is - begin - Comps (To) := Comps (From); - end Move; + ---------- + -- Move -- + ---------- + procedure Move (From : Natural; To : Natural) is begin - -- Gather discriminants into Comp + Comps (To) := Comps (From); + end Move; - Citem := First (DS); - while Present (Citem) loop - if Nkind (Citem) = N_Discriminant_Specification then - declare - Ent : constant Entity_Id := - Defining_Identifier (Citem); - begin - if Ekind (Ent) = E_Discriminant then - Ncomps := Ncomps + 1; - Comps (Ncomps) := Ent; - end if; - end; - end if; + -- Start of processing for Check_Component_List - Next (Citem); - end loop; + begin + -- Gather discriminants into Comp - -- Gather component entities into Comp + Citem := First (DS); + while Present (Citem) loop + if Nkind (Citem) = N_Discriminant_Specification then + declare + Ent : constant Entity_Id := + Defining_Identifier (Citem); + begin + if Ekind (Ent) = E_Discriminant then + Ncomps := Ncomps + 1; + Comps (Ncomps) := Ent; + end if; + end; + end if; - Citem := First (Component_Items (CL)); - while Present (Citem) loop - if Nkind (Citem) = N_Component_Declaration then - Ncomps := Ncomps + 1; - Comps (Ncomps) := Defining_Identifier (Citem); - end if; + Next (Citem); + end loop; - Next (Citem); - end loop; + -- Gather component entities into Comp - -- Now sort the component entities based on the first bit. - -- Note we already know there are no overlapping components. + Citem := First (Component_Items (CL)); + while Present (Citem) loop + if Nkind (Citem) = N_Component_Declaration then + Ncomps := Ncomps + 1; + Comps (Ncomps) := Defining_Identifier (Citem); + end if; - Sorting.Sort (Ncomps); + Next (Citem); + end loop; - -- Loop through entries checking for holes + -- Now sort the component entities based on the first bit. + -- Note we already know there are no overlapping components. - Nbit := Sbit; - for J in 1 .. Ncomps loop - CEnt := Comps (J); - pragma Annotate (CodePeer, Modified, CEnt); + Sorting.Sort (Ncomps); - declare - CBO : constant Uint := Component_Bit_Offset (CEnt); + -- Loop through entries checking for holes - begin - -- Skip components with unknown offsets + Nbit := Sbit; + for J in 1 .. Ncomps loop + CEnt := Comps (J); + pragma Annotate (CodePeer, Modified, CEnt); - if Present (CBO) and then CBO >= 0 then - Error_Msg_Uint_1 := CBO - Nbit; + declare + CBO : constant Uint := Component_Bit_Offset (CEnt); - if Warn and then Error_Msg_Uint_1 > 0 then - Error_Msg_NE - ("?.h?^-bit gap before component&", - Component_Name (Component_Clause (CEnt)), - CEnt); - end if; + begin + -- Skip components with unknown offsets + + if Present (CBO) and then CBO >= 0 then + Error_Msg_Uint_1 := CBO - Nbit; - Nbit := CBO + Esize (CEnt); + if Warn and then Error_Msg_Uint_1 > 0 then + Error_Msg_NE + ("?.h?^-bit gap before component&", + Component_Name (Component_Clause (CEnt)), + CEnt); end if; - end; - end loop; - -- Set Abit to just after the last nonvariant component + Nbit := CBO + Esize (CEnt); + end if; + end; + end loop; + + -- Set Abit to just after the last nonvariant component - Abit := Nbit; + Abit := Nbit; - -- Process variant parts recursively if present. Set Abit to - -- the maximum for all variant parts. + -- Process variant parts recursively if present. Set Abit to the + -- maximum for all variant parts. - if Present (Variant_Part (CL)) then - declare - Var_Start : constant Uint := Nbit; - begin - Variant := First (Variants (Variant_Part (CL))); - while Present (Variant) loop - Check_Component_List - (No_List, Component_List (Variant), Var_Start, Nbit); - Next (Variant); - if Nbit > Abit then - Abit := Nbit; - end if; - end loop; - end; - end if; - end; + if Present (Variant_Part (CL)) then + declare + Var_Start : constant Uint := Nbit; + begin + Variant := First (Variants (Variant_Part (CL))); + while Present (Variant) loop + Check_Component_List + (No_List, Component_List (Variant), Var_Start, Nbit); + Next (Variant); + if Nbit > Abit then + Abit := Nbit; + end if; + end loop; + end; + end if; end Check_Component_List; -- Local variables |