diff options
Diffstat (limited to 'gcc/ada/sem_ch13.adb')
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 649 |
1 files changed, 322 insertions, 327 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 67a913919e3..5f067ccc261 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -184,415 +184,410 @@ package body Sem_Ch13 is begin -- Processing depends on version of Ada - case Ada_Version is + -- For Ada 95, we just renumber bits within a storage unit. We do the + -- same for Ada 83 mode, since we recognize pragma Bit_Order in Ada 83, + -- and are free to add this extension. - -- For Ada 95, we just renumber bits within a storage unit. We do - -- the same for Ada 83 mode, since we recognize pragma Bit_Order - -- in Ada 83, and are free to add this extension. + if Ada_Version < Ada_2005 then + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + CC := Component_Clause (Comp); - when Ada_83 | Ada_95 => - Comp := First_Component_Or_Discriminant (R); - while Present (Comp) loop - CC := Component_Clause (Comp); + -- If component clause is present, then deal with the non-default + -- bit order case for Ada 95 mode. - -- If component clause is present, then deal with the non- - -- default bit order case for Ada 95 mode. + -- We only do this processing for the base type, and in fact that + -- is important, since otherwise if there are record subtypes, we + -- could reverse the bits once for each subtype, which is wrong. - -- We only do this processing for the base type, and in - -- fact that's important, since otherwise if there are - -- record subtypes, we could reverse the bits once for - -- each subtype, which would be incorrect. + if Present (CC) + and then Ekind (R) = E_Record_Type + then + declare + CFB : constant Uint := Component_Bit_Offset (Comp); + CSZ : constant Uint := Esize (Comp); + CLC : constant Node_Id := Component_Clause (Comp); + Pos : constant Node_Id := Position (CLC); + FB : constant Node_Id := First_Bit (CLC); - if Present (CC) - and then Ekind (R) = E_Record_Type - then - declare - CFB : constant Uint := Component_Bit_Offset (Comp); - CSZ : constant Uint := Esize (Comp); - CLC : constant Node_Id := Component_Clause (Comp); - Pos : constant Node_Id := Position (CLC); - FB : constant Node_Id := First_Bit (CLC); + Storage_Unit_Offset : constant Uint := + CFB / System_Storage_Unit; - Storage_Unit_Offset : constant Uint := - CFB / System_Storage_Unit; + Start_Bit : constant Uint := + CFB mod System_Storage_Unit; - Start_Bit : constant Uint := - CFB mod System_Storage_Unit; + begin + -- Cases where field goes over storage unit boundary - begin - -- Cases where field goes over storage unit boundary + if Start_Bit + CSZ > System_Storage_Unit then - if Start_Bit + CSZ > System_Storage_Unit then + -- Allow multi-byte field but generate warning - -- Allow multi-byte field but generate warning + if Start_Bit mod System_Storage_Unit = 0 + and then CSZ mod System_Storage_Unit = 0 + then + Error_Msg_N + ("multi-byte field specified with non-standard" + & " Bit_Order?", CLC); - if Start_Bit mod System_Storage_Unit = 0 - and then CSZ mod System_Storage_Unit = 0 - then + if Bytes_Big_Endian then Error_Msg_N - ("multi-byte field specified with non-standard" - & " Bit_Order?", CLC); - - if Bytes_Big_Endian then - Error_Msg_N - ("bytes are not reversed " - & "(component is big-endian)?", CLC); - else - Error_Msg_N - ("bytes are not reversed " - & "(component is little-endian)?", CLC); - end if; - - -- Do not allow non-contiguous field - + ("bytes are not reversed " + & "(component is big-endian)?", CLC); else Error_Msg_N - ("attempt to specify non-contiguous field " - & "not permitted", CLC); - Error_Msg_N - ("\caused by non-standard Bit_Order " - & "specified", CLC); - Error_Msg_N - ("\consider possibility of using " - & "Ada 2005 mode here", CLC); + ("bytes are not reversed " + & "(component is little-endian)?", CLC); end if; - -- Case where field fits in one storage unit + -- Do not allow non-contiguous field else - -- Give warning if suspicious component clause + Error_Msg_N + ("attempt to specify non-contiguous field " + & "not permitted", CLC); + Error_Msg_N + ("\caused by non-standard Bit_Order " + & "specified", CLC); + Error_Msg_N + ("\consider possibility of using " + & "Ada 2005 mode here", CLC); + end if; - if Intval (FB) >= System_Storage_Unit - and then Warn_On_Reverse_Bit_Order - then - Error_Msg_N - ("?Bit_Order clause does not affect " & - "byte ordering", Pos); - Error_Msg_Uint_1 := - Intval (Pos) + Intval (FB) / - System_Storage_Unit; - Error_Msg_N - ("?position normalized to ^ before bit " & - "order interpreted", Pos); - end if; + -- Case where field fits in one storage unit + + else + -- Give warning if suspicious component clause + + if Intval (FB) >= System_Storage_Unit + and then Warn_On_Reverse_Bit_Order + then + Error_Msg_N + ("?Bit_Order clause does not affect " & + "byte ordering", Pos); + Error_Msg_Uint_1 := + Intval (Pos) + Intval (FB) / + System_Storage_Unit; + Error_Msg_N + ("?position normalized to ^ before bit " & + "order interpreted", Pos); + end if; - -- Here is where we fix up the Component_Bit_Offset - -- value to account for the reverse bit order. - -- Some examples of what needs to be done are: + -- Here is where we fix up the Component_Bit_Offset value + -- to account for the reverse bit order. Some examples of + -- what needs to be done are: - -- First_Bit .. Last_Bit Component_Bit_Offset - -- old new old new + -- First_Bit .. Last_Bit Component_Bit_Offset + -- old new old new - -- 0 .. 0 7 .. 7 0 7 - -- 0 .. 1 6 .. 7 0 6 - -- 0 .. 2 5 .. 7 0 5 - -- 0 .. 7 0 .. 7 0 4 + -- 0 .. 0 7 .. 7 0 7 + -- 0 .. 1 6 .. 7 0 6 + -- 0 .. 2 5 .. 7 0 5 + -- 0 .. 7 0 .. 7 0 4 - -- 1 .. 1 6 .. 6 1 6 - -- 1 .. 4 3 .. 6 1 3 - -- 4 .. 7 0 .. 3 4 0 + -- 1 .. 1 6 .. 6 1 6 + -- 1 .. 4 3 .. 6 1 3 + -- 4 .. 7 0 .. 3 4 0 - -- The general rule is that the first bit is - -- is obtained by subtracting the old ending bit - -- from storage_unit - 1. + -- The rule is that the first bit is is obtained by + -- subtracting the old ending bit from storage_unit - 1. - Set_Component_Bit_Offset - (Comp, - (Storage_Unit_Offset * System_Storage_Unit) + - (System_Storage_Unit - 1) - - (Start_Bit + CSZ - 1)); + Set_Component_Bit_Offset + (Comp, + (Storage_Unit_Offset * System_Storage_Unit) + + (System_Storage_Unit - 1) - + (Start_Bit + CSZ - 1)); - Set_Normalized_First_Bit - (Comp, - Component_Bit_Offset (Comp) mod - System_Storage_Unit); - end if; - end; - end if; + Set_Normalized_First_Bit + (Comp, + Component_Bit_Offset (Comp) mod + System_Storage_Unit); + end if; + end; + end if; - Next_Component_Or_Discriminant (Comp); - end loop; + Next_Component_Or_Discriminant (Comp); + end loop; - -- For Ada 2005, we do machine scalar processing, as fully described - -- In AI-133. This involves gathering all components which start at - -- the same byte offset and processing them together + -- For Ada 2005, we do machine scalar processing, as fully described In + -- AI-133. This involves gathering all components which start at the + -- same byte offset and processing them together. Same approach is still + -- valid in later versions including Ada 2012. - when Ada_05 .. Ada_Version_Type'Last => - declare - Max_Machine_Scalar_Size : constant Uint := - UI_From_Int - (Standard_Long_Long_Integer_Size); + else + declare + Max_Machine_Scalar_Size : constant Uint := + UI_From_Int + (Standard_Long_Long_Integer_Size); -- We use this as the maximum machine scalar size - Num_CC : Natural; - SSU : constant Uint := UI_From_Int (System_Storage_Unit); + Num_CC : Natural; + SSU : constant Uint := UI_From_Int (System_Storage_Unit); - begin - -- This first loop through components does two things. First it - -- deals with the case of components with component clauses - -- whose length is greater than the maximum machine scalar size - -- (either accepting them or rejecting as needed). Second, it - -- counts the number of components with component clauses whose - -- length does not exceed this maximum for later processing. + begin + -- This first loop through components does two things. First it + -- deals with the case of components with component clauses whose + -- length is greater than the maximum machine scalar size (either + -- accepting them or rejecting as needed). Second, it counts the + -- number of components with component clauses whose length does + -- not exceed this maximum for later processing. + + Num_CC := 0; + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + CC := Component_Clause (Comp); - Num_CC := 0; - Comp := First_Component_Or_Discriminant (R); - while Present (Comp) loop - CC := Component_Clause (Comp); + if Present (CC) then + declare + Fbit : constant Uint := + Static_Integer (First_Bit (CC)); - if Present (CC) then - declare - Fbit : constant Uint := - Static_Integer (First_Bit (CC)); + begin + -- Case of component with size > max machine scalar - begin - -- Case of component with size > max machine scalar + if Esize (Comp) > Max_Machine_Scalar_Size then - if Esize (Comp) > Max_Machine_Scalar_Size then + -- Must begin on byte boundary - -- Must begin on byte boundary + if Fbit mod SSU /= 0 then + Error_Msg_N + ("illegal first bit value for " + & "reverse bit order", + First_Bit (CC)); + Error_Msg_Uint_1 := SSU; + Error_Msg_Uint_2 := Max_Machine_Scalar_Size; - if Fbit mod SSU /= 0 then - Error_Msg_N - ("illegal first bit value for " - & "reverse bit order", - First_Bit (CC)); - Error_Msg_Uint_1 := SSU; - Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + Error_Msg_N + ("\must be a multiple of ^ " + & "if size greater than ^", + First_Bit (CC)); - Error_Msg_N - ("\must be a multiple of ^ " - & "if size greater than ^", - First_Bit (CC)); + -- Must end on byte boundary - -- Must end on byte boundary + elsif Esize (Comp) mod SSU /= 0 then + Error_Msg_N + ("illegal last bit value for " + & "reverse bit order", + Last_Bit (CC)); + Error_Msg_Uint_1 := SSU; + Error_Msg_Uint_2 := Max_Machine_Scalar_Size; - elsif Esize (Comp) mod SSU /= 0 then - Error_Msg_N - ("illegal last bit value for " - & "reverse bit order", - Last_Bit (CC)); - Error_Msg_Uint_1 := SSU; - Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + Error_Msg_N + ("\must be a multiple of ^ if size " + & "greater than ^", + Last_Bit (CC)); - Error_Msg_N - ("\must be a multiple of ^ if size " - & "greater than ^", - Last_Bit (CC)); + -- OK, give warning if enabled - -- OK, give warning if enabled + elsif Warn_On_Reverse_Bit_Order then + Error_Msg_N + ("multi-byte field specified with " + & " non-standard Bit_Order?", CC); - elsif Warn_On_Reverse_Bit_Order then + if Bytes_Big_Endian then + Error_Msg_N + ("\bytes are not reversed " + & "(component is big-endian)?", CC); + else Error_Msg_N - ("multi-byte field specified with " - & " non-standard Bit_Order?", CC); - - if Bytes_Big_Endian then - Error_Msg_N - ("\bytes are not reversed " - & "(component is big-endian)?", CC); - else - Error_Msg_N - ("\bytes are not reversed " - & "(component is little-endian)?", CC); - end if; + ("\bytes are not reversed " + & "(component is little-endian)?", CC); end if; + end if; - -- Case where size is not greater than max machine - -- scalar. For now, we just count these. + -- Case where size is not greater than max machine + -- scalar. For now, we just count these. - else - Num_CC := Num_CC + 1; - end if; - end; - end if; + else + Num_CC := Num_CC + 1; + end if; + end; + end if; - Next_Component_Or_Discriminant (Comp); - end loop; + Next_Component_Or_Discriminant (Comp); + end loop; - -- We need to sort the component clauses on the basis of the - -- Position values in the clause, so we can group clauses with - -- the same Position. together to determine the relevant - -- machine scalar size. + -- We need to sort the component clauses on the basis of the + -- Position values in the clause, so we can group clauses with + -- the same Position. together to determine the relevant machine + -- scalar size. - Sort_CC : declare - Comps : array (0 .. Num_CC) of Entity_Id; - -- Array to collect component and discriminant entities. The - -- data starts at index 1, the 0'th entry is for the sort - -- routine. + Sort_CC : declare + Comps : array (0 .. Num_CC) of Entity_Id; + -- Array to collect component and discriminant entities. The + -- data starts at index 1, the 0'th entry is for the sort + -- routine. - function CP_Lt (Op1, Op2 : Natural) return Boolean; - -- Compare routine for Sort + function CP_Lt (Op1, Op2 : Natural) return Boolean; + -- Compare routine for Sort - procedure CP_Move (From : Natural; To : Natural); - -- Move routine for Sort + procedure CP_Move (From : Natural; To : Natural); + -- Move routine for Sort - package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt); + package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt); - Start : Natural; - Stop : Natural; - -- Start and stop positions in component list of set of - -- components with the same starting position (that - -- constitute components in a single machine scalar). + Start : Natural; + Stop : Natural; + -- Start and stop positions in the component list of the set of + -- components with the same starting position (that constitute + -- components in a single machine scalar). - MaxL : Uint; - -- Maximum last bit value of any component in this set + MaxL : Uint; + -- Maximum last bit value of any component in this set - MSS : Uint; - -- Corresponding machine scalar size + MSS : Uint; + -- Corresponding machine scalar size - ----------- - -- CP_Lt -- - ----------- + ----------- + -- CP_Lt -- + ----------- - function CP_Lt (Op1, Op2 : Natural) return Boolean is - begin - return Position (Component_Clause (Comps (Op1))) < - Position (Component_Clause (Comps (Op2))); - end CP_Lt; + function CP_Lt (Op1, Op2 : Natural) return Boolean is + begin + return Position (Component_Clause (Comps (Op1))) < + Position (Component_Clause (Comps (Op2))); + end CP_Lt; - ------------- - -- CP_Move -- - ------------- + ------------- + -- CP_Move -- + ------------- - procedure CP_Move (From : Natural; To : Natural) is - begin - Comps (To) := Comps (From); - end CP_Move; + procedure CP_Move (From : Natural; To : Natural) is + begin + Comps (To) := Comps (From); + end CP_Move; -- Start of processing for Sort_CC - begin - -- Collect the component clauses + begin + -- Collect the component clauses - Num_CC := 0; - Comp := First_Component_Or_Discriminant (R); - while Present (Comp) loop - if Present (Component_Clause (Comp)) - and then Esize (Comp) <= Max_Machine_Scalar_Size - then - Num_CC := Num_CC + 1; - Comps (Num_CC) := Comp; - end if; + Num_CC := 0; + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + if Present (Component_Clause (Comp)) + and then Esize (Comp) <= Max_Machine_Scalar_Size + then + Num_CC := Num_CC + 1; + Comps (Num_CC) := Comp; + end if; - Next_Component_Or_Discriminant (Comp); - end loop; + Next_Component_Or_Discriminant (Comp); + end loop; - -- Sort by ascending position number + -- Sort by ascending position number - Sorting.Sort (Num_CC); + Sorting.Sort (Num_CC); - -- We now have all the components whose size does not exceed - -- the max machine scalar value, sorted by starting - -- position. In this loop we gather groups of clauses - -- starting at the same position, to process them in - -- accordance with Ada 2005 AI-133. + -- We now have all the components whose size does not exceed + -- the max machine scalar value, sorted by starting position. + -- In this loop we gather groups of clauses starting at the + -- same position, to process them in accordance with AI-133. - Stop := 0; + Stop := 0; + while Stop < Num_CC loop + Start := Stop + 1; + Stop := Start; + MaxL := + Static_Integer + (Last_Bit (Component_Clause (Comps (Start)))); while Stop < Num_CC loop - Start := Stop + 1; - Stop := Start; - MaxL := - Static_Integer - (Last_Bit (Component_Clause (Comps (Start)))); - while Stop < Num_CC loop - if Static_Integer - (Position (Component_Clause (Comps (Stop + 1)))) = - Static_Integer - (Position (Component_Clause (Comps (Stop)))) - then - Stop := Stop + 1; - MaxL := - UI_Max - (MaxL, - Static_Integer - (Last_Bit - (Component_Clause (Comps (Stop))))); - else - exit; - end if; - end loop; + if Static_Integer + (Position (Component_Clause (Comps (Stop + 1)))) = + Static_Integer + (Position (Component_Clause (Comps (Stop)))) + then + Stop := Stop + 1; + MaxL := + UI_Max + (MaxL, + Static_Integer + (Last_Bit + (Component_Clause (Comps (Stop))))); + else + exit; + end if; + end loop; - -- Now we have a group of component clauses from Start to - -- Stop whose positions are identical, and MaxL is the - -- maximum last bit value of any of these components. - - -- We need to determine the corresponding machine scalar - -- size. This loop assumes that machine scalar sizes are - -- even, and that each possible machine scalar has twice - -- as many bits as the next smaller one. - - MSS := Max_Machine_Scalar_Size; - while MSS mod 2 = 0 - and then (MSS / 2) >= SSU - and then (MSS / 2) > MaxL - loop - MSS := MSS / 2; - end loop; + -- Now we have a group of component clauses from Start to + -- Stop whose positions are identical, and MaxL is the + -- maximum last bit value of any of these components. - -- Here is where we fix up the Component_Bit_Offset value - -- to account for the reverse bit order. Some examples of - -- what needs to be done for the case of a machine scalar - -- size of 8 are: + -- We need to determine the corresponding machine scalar + -- size. This loop assumes that machine scalar sizes are + -- even, and that each possible machine scalar has twice + -- as many bits as the next smaller one. - -- First_Bit .. Last_Bit Component_Bit_Offset - -- old new old new + MSS := Max_Machine_Scalar_Size; + while MSS mod 2 = 0 + and then (MSS / 2) >= SSU + and then (MSS / 2) > MaxL + loop + MSS := MSS / 2; + end loop; - -- 0 .. 0 7 .. 7 0 7 - -- 0 .. 1 6 .. 7 0 6 - -- 0 .. 2 5 .. 7 0 5 - -- 0 .. 7 0 .. 7 0 4 + -- Here is where we fix up the Component_Bit_Offset value + -- to account for the reverse bit order. Some examples of + -- what needs to be done for the case of a machine scalar + -- size of 8 are: - -- 1 .. 1 6 .. 6 1 6 - -- 1 .. 4 3 .. 6 1 3 - -- 4 .. 7 0 .. 3 4 0 + -- First_Bit .. Last_Bit Component_Bit_Offset + -- old new old new - -- The general rule is that the first bit is obtained by - -- subtracting the old ending bit from machine scalar - -- size - 1. + -- 0 .. 0 7 .. 7 0 7 + -- 0 .. 1 6 .. 7 0 6 + -- 0 .. 2 5 .. 7 0 5 + -- 0 .. 7 0 .. 7 0 4 - for C in Start .. Stop loop - declare - Comp : constant Entity_Id := Comps (C); - CC : constant Node_Id := - Component_Clause (Comp); - LB : constant Uint := - Static_Integer (Last_Bit (CC)); - NFB : constant Uint := MSS - Uint_1 - LB; - NLB : constant Uint := NFB + Esize (Comp) - 1; - Pos : constant Uint := - Static_Integer (Position (CC)); + -- 1 .. 1 6 .. 6 1 6 + -- 1 .. 4 3 .. 6 1 3 + -- 4 .. 7 0 .. 3 4 0 - begin - if Warn_On_Reverse_Bit_Order then - Error_Msg_Uint_1 := MSS; - Error_Msg_N - ("info: reverse bit order in machine " & - "scalar of length^?", First_Bit (CC)); - Error_Msg_Uint_1 := NFB; - Error_Msg_Uint_2 := NLB; - - if Bytes_Big_Endian then - Error_Msg_NE - ("?\info: big-endian range for " - & "component & is ^ .. ^", - First_Bit (CC), Comp); - else - Error_Msg_NE - ("?\info: little-endian range " - & "for component & is ^ .. ^", - First_Bit (CC), Comp); - end if; + -- The rule is that the first bit is obtained by subtracting + -- the old ending bit from machine scalar size - 1. + + for C in Start .. Stop loop + declare + Comp : constant Entity_Id := Comps (C); + CC : constant Node_Id := + Component_Clause (Comp); + LB : constant Uint := + Static_Integer (Last_Bit (CC)); + NFB : constant Uint := MSS - Uint_1 - LB; + NLB : constant Uint := NFB + Esize (Comp) - 1; + Pos : constant Uint := + Static_Integer (Position (CC)); + + begin + if Warn_On_Reverse_Bit_Order then + Error_Msg_Uint_1 := MSS; + Error_Msg_N + ("info: reverse bit order in machine " & + "scalar of length^?", First_Bit (CC)); + Error_Msg_Uint_1 := NFB; + Error_Msg_Uint_2 := NLB; + + if Bytes_Big_Endian then + Error_Msg_NE + ("?\info: big-endian range for " + & "component & is ^ .. ^", + First_Bit (CC), Comp); + else + Error_Msg_NE + ("?\info: little-endian range " + & "for component & is ^ .. ^", + First_Bit (CC), Comp); end if; + end if; - Set_Component_Bit_Offset (Comp, Pos * SSU + NFB); - Set_Normalized_First_Bit (Comp, NFB mod SSU); - end; - end loop; + Set_Component_Bit_Offset (Comp, Pos * SSU + NFB); + Set_Normalized_First_Bit (Comp, NFB mod SSU); + end; end loop; - end Sort_CC; - end; - end case; + end loop; + end Sort_CC; + end; + end if; end Adjust_Record_For_Reverse_Bit_Order; -------------------------------------- |