diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 662 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.ads | 5 |
5 files changed, 364 insertions, 328 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c279bce..91aadda 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2017-01-23 Thomas Quinot <quinot@adacore.com> + + * sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): + Split original Ada 95 part off into new subprogram + below. Call that subprogram (instead of proceeding with + AI95-0133 behaviour) if debug switch -gnatd.p is in use. + (Adjust_Record_For_Reverse_Bit_Order_Ada_95): ... new subprogram + * debug.adb Document new switch -gnatd.p + * freeze.adb (Freeze_Entity.Freeze_Record_Type): Do not adjust + record for reverse bit order if an error has already been posted + on the record type. This avoids generating extraneous "info:" + messages for illegal code. + 2017-01-23 Justin Squirek <squirek@adacore.com> * sem_ch3.adb (Analyze_Declarations): Correct comments diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 218179f..01144f5 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -106,7 +106,7 @@ package body Debug is -- d.m For -gnatl, print full source only for main unit -- d.n Print source file names -- d.o Conservative elaboration order for indirect calls - -- d.p + -- d.p Use original Ada 95 semantics for Bit_Order (disable AI95-0133) -- d.q -- d.r Enable OK_To_Reorder_Components in non-variant records -- d.s @@ -558,6 +558,10 @@ package body Debug is -- d.o Conservative elaboration order for indirect calls. This causes -- P'Access to be treated as a call in more cases. + -- d.p In Ada 95 (or 83) mode, use original Ada 95 behaviour for the + -- interpretation of component clauses crossing byte boundaries when + -- using the non-default bit order (i.e. ignore AI95-0133). + -- d.r Forces the flag OK_To_Reorder_Components to be set in all record -- base types that have no discriminants. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index c8eef9c..0dd5587 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4262,10 +4262,14 @@ package body Freeze is ("\??since no component clauses were specified", ADC); -- Here is where we do the processing to adjust component clauses - -- for reversed bit order, when not using reverse SSO. + -- for reversed bit order, when not using reverse SSO. If an error + -- has been reported on Rec already (such as SSO incompatible with + -- bit order), don't bother adjusting as this may generate extra + -- noise. elsif Reverse_Bit_Order (Rec) and then not Reverse_Storage_Order (Rec) + and then not Error_Posted (Rec) then Adjust_Record_For_Reverse_Bit_Order (Rec); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index bdb53b1..9956814 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -80,6 +80,10 @@ package body Sem_Ch13 is -- Local Subprograms -- ----------------------- + procedure Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R : Entity_Id); + -- Helper routine providing the original (pre-AI95-0133) behaviour for + -- Adjust_Record_For_Reverse_Bit_Order. + procedure Alignment_Check_For_Size_Change (Typ : Entity_Id; Size : Uint); -- This routine is called after setting one of the sizes of type entity -- Typ to Size. The purpose is to deal with the situation of a derived @@ -351,372 +355,404 @@ package body Sem_Ch13 is Comp : Node_Id; CC : Node_Id; - begin - -- Processing depends on version of Ada + Max_Machine_Scalar_Size : constant Uint := + UI_From_Int + (Standard_Long_Long_Integer_Size); + -- We use this as the maximum machine scalar size - -- For Ada 95, we just renumber bits within a storage unit. We do the - -- same for Ada 83 mode, since we recognize the Bit_Order attribute in - -- Ada 83, and are free to add this extension. + Num_CC : Natural; + SSU : constant Uint := UI_From_Int (System_Storage_Unit); - if Ada_Version < Ada_2005 then - Comp := First_Component_Or_Discriminant (R); - while Present (Comp) loop - CC := Component_Clause (Comp); + begin + -- Processing here used to depend on Ada version: the behaviour was + -- changed by AI95-0133. However this AI is a Binding interpretation, + -- so we now implement it even in Ada 95 mode. The original behaviour + -- from unamended Ada 95 is still available for compatibility under + -- debugging switch -gnatd. + + if Ada_Version < Ada_2005 and then Debug_Flag_Dot_P then + Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R); + return; + end if; + + -- 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. - -- If component clause is present, then deal with the non-default - -- bit order case for Ada 95 mode. + -- 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. - -- 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. + Num_CC := 0; + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + CC := Component_Clause (Comp); - 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) then + declare + Fbit : constant Uint := Static_Integer (First_Bit (CC)); + Lbit : constant Uint := Static_Integer (Last_Bit (CC)); - Storage_Unit_Offset : constant Uint := - CFB / System_Storage_Unit; + begin + -- Case of component with last bit >= max machine scalar - Start_Bit : constant Uint := - CFB mod System_Storage_Unit; + if Lbit >= Max_Machine_Scalar_Size then - begin - -- Cases where field goes over storage unit boundary + -- This is allowed only if first bit is zero, and + -- last bit + 1 is a multiple of storage unit size. - if Start_Bit + CSZ > System_Storage_Unit then + if Fbit = 0 and then (Lbit + 1) mod SSU = 0 then - -- Allow multi-byte field but generate warning + -- This is the case to give a warning if enabled - if Start_Bit mod System_Storage_Unit = 0 - and then CSZ mod System_Storage_Unit = 0 - then + if Warn_On_Reverse_Bit_Order then Error_Msg_N ("info: multi-byte field specified with " - & "non-standard Bit_Order?V?", CLC); + & "non-standard Bit_Order?V?", CC); if Bytes_Big_Endian then Error_Msg_N ("\bytes are not reversed " - & "(component is big-endian)?V?", CLC); + & "(component is big-endian)?V?", CC); else Error_Msg_N ("\bytes are not reversed " - & "(component is little-endian)?V?", CLC); + & "(component is little-endian)?V?", CC); end if; + end if; - -- Do not allow non-contiguous field + -- Give error message for RM 13.5.1(10) violation + + else + Error_Msg_FE + ("machine scalar rules not followed for&", + First_Bit (CC), Comp); + + Error_Msg_Uint_1 := Lbit + 1; + Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + Error_Msg_F + ("\last bit + 1 (^) exceeds maximum machine " + & "scalar size (^)", + First_Bit (CC)); + + if (Lbit + 1) mod SSU /= 0 then + Error_Msg_Uint_1 := SSU; + Error_Msg_F + ("\and is not a multiple of Storage_Unit (^) " + & "(RM 13.5.1(10))", + First_Bit (CC)); 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); + Error_Msg_Uint_1 := Fbit; + Error_Msg_F + ("\and first bit (^) is non-zero " + & "(RM 13.4.1(10))", + First_Bit (CC)); end if; + end if; - -- Case where field fits in one storage unit + -- OK case of machine scalar related component clause, + -- For now, just count them. - else - -- Give warning if suspicious component clause + else + Num_CC := Num_CC + 1; + end if; + end; + end if; - if Intval (FB) >= System_Storage_Unit - and then Warn_On_Reverse_Bit_Order - then - Error_Msg_N - ("info: Bit_Order clause does not affect " & - "byte ordering?V?", Pos); - Error_Msg_Uint_1 := - Intval (Pos) + Intval (FB) / - System_Storage_Unit; - Error_Msg_N - ("info: position normalized to ^ before bit " & - "order interpreted?V?", Pos); - end if; + Next_Component_Or_Discriminant (Comp); + end loop; - -- 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: + -- 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. - -- First_Bit .. Last_Bit Component_Bit_Offset - -- old new old new + 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. - -- 0 .. 0 7 .. 7 0 7 - -- 0 .. 1 6 .. 7 0 6 - -- 0 .. 2 5 .. 7 0 5 - -- 0 .. 7 0 .. 7 0 4 + function CP_Lt (Op1, Op2 : Natural) return Boolean; + -- Compare routine for Sort - -- 1 .. 1 6 .. 6 1 6 - -- 1 .. 4 3 .. 6 1 3 - -- 4 .. 7 0 .. 3 4 0 + procedure CP_Move (From : Natural; To : Natural); + -- Move routine for Sort - -- The rule is that the first bit is is obtained by - -- subtracting the old ending bit from storage_unit - 1. + package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt); - Set_Component_Bit_Offset - (Comp, - (Storage_Unit_Offset * System_Storage_Unit) + - (System_Storage_Unit - 1) - - (Start_Bit + CSZ - 1)); + 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). - Set_Normalized_First_Bit - (Comp, - Component_Bit_Offset (Comp) mod - System_Storage_Unit); - end if; - end; - end if; + MaxL : Uint; + -- Maximum last bit value of any component in this set - Next_Component_Or_Discriminant (Comp); - end loop; + MSS : Uint; + -- Corresponding machine scalar size - -- 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. + ----------- + -- CP_Lt -- + ----------- - 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 + function CP_Lt (Op1, Op2 : Natural) return Boolean is + begin + return Position (Component_Clause (Comps (Op1))) < + Position (Component_Clause (Comps (Op2))); + end CP_Lt; - Num_CC : Natural; - SSU : constant Uint := UI_From_Int (System_Storage_Unit); + ------------- + -- CP_Move -- + ------------- + procedure CP_Move (From : Natural; To : Natural) is 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); + Comps (To) := Comps (From); + end CP_Move; - if Present (CC) then - declare - Fbit : constant Uint := Static_Integer (First_Bit (CC)); - Lbit : constant Uint := Static_Integer (Last_Bit (CC)); + -- Start of processing for Sort_CC - begin - -- Case of component with last bit >= max machine scalar + begin + -- Collect the machine scalar relevant component clauses - if Lbit >= Max_Machine_Scalar_Size then + Num_CC := 0; + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + declare + CC : constant Node_Id := Component_Clause (Comp); - -- This is allowed only if first bit is zero, and - -- last bit + 1 is a multiple of storage unit size. + begin + -- Collect only component clauses whose last bit is less + -- than machine scalar size. Any component clause whose + -- last bit exceeds this value does not take part in + -- machine scalar layout considerations. The test for + -- Error_Posted makes sure we exclude component clauses + -- for which we already posted an error. + + if Present (CC) + and then not Error_Posted (Last_Bit (CC)) + and then Static_Integer (Last_Bit (CC)) < + Max_Machine_Scalar_Size + then + Num_CC := Num_CC + 1; + Comps (Num_CC) := Comp; + end if; + end; - if Fbit = 0 and then (Lbit + 1) mod SSU = 0 then + Next_Component_Or_Discriminant (Comp); + end loop; - -- This is the case to give a warning if enabled + -- Sort by ascending position number + + 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 AI-133. + + 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 + 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 Warn_On_Reverse_Bit_Order then - Error_Msg_N - ("info: multi-byte field specified with " - & "non-standard Bit_Order?V?", CC); - - if Bytes_Big_Endian then - Error_Msg_N - ("\bytes are not reversed " - & "(component is big-endian)?V?", CC); - else - Error_Msg_N - ("\bytes are not reversed " - & "(component is little-endian)?V?", CC); - end if; - end if; + -- 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. - -- Give error message for RM 13.5.1(10) violation + -- 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. - else - Error_Msg_FE - ("machine scalar rules not followed for&", - First_Bit (CC), Comp); + 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; - Error_Msg_Uint_1 := Lbit + 1; - Error_Msg_Uint_2 := Max_Machine_Scalar_Size; - Error_Msg_F - ("\last bit + 1 (^) exceeds maximum machine " - & "scalar size (^)", - First_Bit (CC)); + -- 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: - if (Lbit + 1) mod SSU /= 0 then - Error_Msg_Uint_1 := SSU; - Error_Msg_F - ("\and is not a multiple of Storage_Unit (^) " - & "(RM 13.5.1(10))", - First_Bit (CC)); + -- First_Bit .. Last_Bit Component_Bit_Offset + -- old new old new - else - Error_Msg_Uint_1 := Fbit; - Error_Msg_F - ("\and first bit (^) is non-zero " - & "(RM 13.4.1(10))", - First_Bit (CC)); - end if; - end if; + -- 0 .. 0 7 .. 7 0 7 + -- 0 .. 1 6 .. 7 0 6 + -- 0 .. 2 5 .. 7 0 5 + -- 0 .. 7 0 .. 7 0 4 - -- OK case of machine scalar related component clause, - -- For now, just count them. + -- 1 .. 1 6 .. 6 1 6 + -- 1 .. 4 3 .. 6 1 3 + -- 4 .. 7 0 .. 3 4 0 - else - Num_CC := Num_CC + 1; - end if; - end; - end if; + -- The rule is that the first bit is obtained by subtracting + -- the old ending bit from machine scalar size - 1. - Next_Component_Or_Discriminant (Comp); - end loop; + for C in Start .. Stop loop + declare + Comp : constant Entity_Id := Comps (C); + CC : constant Node_Id := Component_Clause (Comp); - -- 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. + 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)); - 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. + 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^?V?", First_Bit (CC)); + Error_Msg_Uint_1 := NFB; + Error_Msg_Uint_2 := NLB; - function CP_Lt (Op1, Op2 : Natural) return Boolean; - -- Compare routine for Sort + if Bytes_Big_Endian then + Error_Msg_NE + ("\big-endian range for component " + & "& is ^ .. ^?V?", First_Bit (CC), Comp); + else + Error_Msg_NE + ("\little-endian range for component" + & "& is ^ .. ^?V?", First_Bit (CC), Comp); + end if; + end if; - procedure CP_Move (From : Natural; To : Natural); - -- Move routine for Sort + Set_Component_Bit_Offset (Comp, Pos * SSU + NFB); + Set_Normalized_First_Bit (Comp, NFB mod SSU); + end; + end loop; + end loop; + end Sort_CC; + end Adjust_Record_For_Reverse_Bit_Order; - package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt); + ------------------------------------------------ + -- Adjust_Record_For_Reverse_Bit_Order_Ada_95 -- + ------------------------------------------------ - 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). + procedure Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R : Entity_Id) is + Comp : Node_Id; + CC : Node_Id; - MaxL : Uint; - -- Maximum last bit value of any component in this set + begin + -- For Ada 95, we just renumber bits within a storage unit. We do the + -- same for Ada 83 mode, since we recognize the Bit_Order attribute in + -- Ada 83, and are free to add this extension. - MSS : Uint; - -- Corresponding machine scalar size + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + CC := Component_Clause (Comp); - ----------- - -- CP_Lt -- - ----------- + -- If component clause is present, then deal with the non-default + -- bit order case for Ada 95 mode. - function CP_Lt (Op1, Op2 : Natural) return Boolean is - begin - return Position (Component_Clause (Comps (Op1))) < - Position (Component_Clause (Comps (Op2))); - end CP_Lt; + -- 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. - ------------- - -- CP_Move -- - ------------- + 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); - procedure CP_Move (From : Natural; To : Natural) is - begin - Comps (To) := Comps (From); - end CP_Move; + Storage_Unit_Offset : constant Uint := + CFB / System_Storage_Unit; - -- Start of processing for Sort_CC + Start_Bit : constant Uint := + CFB mod System_Storage_Unit; begin - -- Collect the machine scalar relevant component clauses + -- Cases where field goes over storage unit boundary - Num_CC := 0; - Comp := First_Component_Or_Discriminant (R); - while Present (Comp) loop - declare - CC : constant Node_Id := Component_Clause (Comp); + if Start_Bit + CSZ > System_Storage_Unit then - begin - -- Collect only component clauses whose last bit is less - -- than machine scalar size. Any component clause whose - -- last bit exceeds this value does not take part in - -- machine scalar layout considerations. The test for - -- Error_Posted makes sure we exclude component clauses - -- for which we already posted an error. - - if Present (CC) - and then not Error_Posted (Last_Bit (CC)) - and then Static_Integer (Last_Bit (CC)) < - Max_Machine_Scalar_Size - then - Num_CC := Num_CC + 1; - Comps (Num_CC) := Comp; - end if; - end; + -- Allow multi-byte field but generate warning - Next_Component_Or_Discriminant (Comp); - end loop; + if Start_Bit mod System_Storage_Unit = 0 + and then CSZ mod System_Storage_Unit = 0 + then + Error_Msg_N + ("info: multi-byte field specified with " + & "non-standard Bit_Order?V?", CLC); - -- Sort by ascending position number - - 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 AI-133. - - 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 - 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))))); + if Bytes_Big_Endian then + Error_Msg_N + ("\bytes are not reversed " + & "(component is big-endian)?V?", CLC); else - exit; + Error_Msg_N + ("\bytes are not reversed " + & "(component is little-endian)?V?", CLC); 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; + -- Do not allow non-contiguous field + + else + Error_Msg_N + ("attempt to specify non-contiguous field " + & "not permitted", CLC); + Error_Msg_N + ("\caused by non-standard Bit_Order " + & "specified in legacy Ada 95 mode", CLC); + 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 + ("info: Bit_Order clause does not affect " & + "byte ordering?V?", Pos); + Error_Msg_Uint_1 := + Intval (Pos) + Intval (FB) / + System_Storage_Unit; + Error_Msg_N + ("info: position normalized to ^ before bit " & + "order interpreted?V?", 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 for the case of a machine scalar - -- size of 8 are: + -- what needs to be done are: -- First_Bit .. Last_Bit Component_Bit_Offset -- old new old new @@ -730,48 +766,26 @@ package body Sem_Ch13 is -- 1 .. 4 3 .. 6 1 3 -- 4 .. 7 0 .. 3 4 0 - -- 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); + -- The rule is that the first bit is is obtained by + -- subtracting the old ending bit from storage_unit - 1. - 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)); + Set_Component_Bit_Offset + (Comp, + (Storage_Unit_Offset * System_Storage_Unit) + + (System_Storage_Unit - 1) - + (Start_Bit + CSZ - 1)); - 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^?V?", First_Bit (CC)); - Error_Msg_Uint_1 := NFB; - Error_Msg_Uint_2 := NLB; - - if Bytes_Big_Endian then - Error_Msg_NE - ("\big-endian range for component " - & "& is ^ .. ^?V?", First_Bit (CC), Comp); - else - Error_Msg_NE - ("\little-endian range for component" - & "& is ^ .. ^?V?", First_Bit (CC), Comp); - end if; - end if; + Set_Normalized_First_Bit + (Comp, + Component_Bit_Offset (Comp) mod + System_Storage_Unit); + end if; + end; + end if; - Set_Component_Bit_Offset (Comp, Pos * SSU + NFB); - Set_Normalized_First_Bit (Comp, NFB mod SSU); - end; - end loop; - end loop; - end Sort_CC; - end; - end if; - end Adjust_Record_For_Reverse_Bit_Order; + Next_Component_Or_Discriminant (Comp); + end loop; + end Adjust_Record_For_Reverse_Bit_Order_Ada_95; ------------------------------------- -- Alignment_Check_For_Size_Change -- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 8003f8e..b99c56f 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -50,8 +50,9 @@ package Sem_Ch13 is procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id); -- Called from Freeze where R is a record entity for which reverse bit - -- order is specified and there is at least one component clause. Adjusts - -- component positions according to either Ada 95 or Ada 2005 (AI-133). + -- order is specified and there is at least one component clause. Note: + -- component positions are normally adjusted as per AI95-0133, unless + -- -gnatd.p is used to restore original Ada 95 mode. procedure Check_Record_Representation_Clause (N : Node_Id); -- This procedure completes the analysis of a record representation clause |