Commit 52b70b1b by Thomas Quinot Committed by Arnaud Charlet

sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Split original Ada 95 part…

sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Split original Ada 95 part off into new subprogram below.

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.

From-SVN: r244786
parent 2a02fa98
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> 2017-01-23 Justin Squirek <squirek@adacore.com>
* sem_ch3.adb (Analyze_Declarations): Correct comments * sem_ch3.adb (Analyze_Declarations): Correct comments
......
...@@ -106,7 +106,7 @@ package body Debug is ...@@ -106,7 +106,7 @@ package body Debug is
-- d.m For -gnatl, print full source only for main unit -- d.m For -gnatl, print full source only for main unit
-- d.n Print source file names -- d.n Print source file names
-- d.o Conservative elaboration order for indirect calls -- 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.q
-- d.r Enable OK_To_Reorder_Components in non-variant records -- d.r Enable OK_To_Reorder_Components in non-variant records
-- d.s -- d.s
...@@ -558,6 +558,10 @@ package body Debug is ...@@ -558,6 +558,10 @@ package body Debug is
-- d.o Conservative elaboration order for indirect calls. This causes -- d.o Conservative elaboration order for indirect calls. This causes
-- P'Access to be treated as a call in more cases. -- 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 -- d.r Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have no discriminants. -- base types that have no discriminants.
......
...@@ -4262,10 +4262,14 @@ package body Freeze is ...@@ -4262,10 +4262,14 @@ package body Freeze is
("\??since no component clauses were specified", ADC); ("\??since no component clauses were specified", ADC);
-- Here is where we do the processing to adjust component clauses -- 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) elsif Reverse_Bit_Order (Rec)
and then not Reverse_Storage_Order (Rec) and then not Reverse_Storage_Order (Rec)
and then not Error_Posted (Rec)
then then
Adjust_Record_For_Reverse_Bit_Order (Rec); Adjust_Record_For_Reverse_Bit_Order (Rec);
......
...@@ -80,6 +80,10 @@ package body Sem_Ch13 is ...@@ -80,6 +80,10 @@ package body Sem_Ch13 is
-- Local Subprograms -- -- 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); procedure Alignment_Check_For_Size_Change (Typ : Entity_Id; Size : Uint);
-- This routine is called after setting one of the sizes of type entity -- 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 -- Typ to Size. The purpose is to deal with the situation of a derived
...@@ -351,372 +355,404 @@ package body Sem_Ch13 is ...@@ -351,372 +355,404 @@ package body Sem_Ch13 is
Comp : Node_Id; Comp : Node_Id;
CC : Node_Id; CC : Node_Id;
begin Max_Machine_Scalar_Size : constant Uint :=
-- Processing depends on version of Ada 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 Num_CC : Natural;
-- same for Ada 83 mode, since we recognize the Bit_Order attribute in SSU : constant Uint := UI_From_Int (System_Storage_Unit);
-- Ada 83, and are free to add this extension.
if Ada_Version < Ada_2005 then begin
Comp := First_Component_Or_Discriminant (R); -- Processing here used to depend on Ada version: the behaviour was
while Present (Comp) loop -- changed by AI95-0133. However this AI is a Binding interpretation,
CC := Component_Clause (Comp); -- 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 -- This first loop through components does two things. First it
-- bit order case for Ada 95 mode. -- 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 Num_CC := 0;
-- is important, since otherwise if there are record subtypes, we Comp := First_Component_Or_Discriminant (R);
-- could reverse the bits once for each subtype, which is wrong. while Present (Comp) loop
CC := Component_Clause (Comp);
if Present (CC) and then Ekind (R) = E_Record_Type then if Present (CC) then
declare declare
CFB : constant Uint := Component_Bit_Offset (Comp); Fbit : constant Uint := Static_Integer (First_Bit (CC));
CSZ : constant Uint := Esize (Comp); Lbit : constant Uint := Static_Integer (Last_Bit (CC));
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 := begin
CFB / System_Storage_Unit; -- Case of component with last bit >= max machine scalar
Start_Bit : constant Uint := if Lbit >= Max_Machine_Scalar_Size then
CFB mod System_Storage_Unit;
begin -- This is allowed only if first bit is zero, and
-- Cases where field goes over storage unit boundary -- 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 if Warn_On_Reverse_Bit_Order then
and then CSZ mod System_Storage_Unit = 0
then
Error_Msg_N Error_Msg_N
("info: multi-byte field specified with " ("info: multi-byte field specified with "
& "non-standard Bit_Order?V?", CLC); & "non-standard Bit_Order?V?", CC);
if Bytes_Big_Endian then if Bytes_Big_Endian then
Error_Msg_N Error_Msg_N
("\bytes are not reversed " ("\bytes are not reversed "
& "(component is big-endian)?V?", CLC); & "(component is big-endian)?V?", CC);
else else
Error_Msg_N Error_Msg_N
("\bytes are not reversed " ("\bytes are not reversed "
& "(component is little-endian)?V?", CLC); & "(component is little-endian)?V?", CC);
end if; 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 else
Error_Msg_N Error_Msg_Uint_1 := Fbit;
("attempt to specify non-contiguous field " Error_Msg_F
& "not permitted", CLC); ("\and first bit (^) is non-zero "
Error_Msg_N & "(RM 13.4.1(10))",
("\caused by non-standard Bit_Order " First_Bit (CC));
& "specified", CLC);
Error_Msg_N
("\consider possibility of using "
& "Ada 2005 mode here", CLC);
end if; 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 else
-- Give warning if suspicious component clause Num_CC := Num_CC + 1;
end if;
end;
end if;
if Intval (FB) >= System_Storage_Unit Next_Component_Or_Discriminant (Comp);
and then Warn_On_Reverse_Bit_Order end loop;
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 -- We need to sort the component clauses on the basis of the
-- to account for the reverse bit order. Some examples of -- Position values in the clause, so we can group clauses with
-- what needs to be done are: -- the same Position together to determine the relevant machine
-- scalar size.
-- First_Bit .. Last_Bit Component_Bit_Offset Sort_CC : declare
-- old new old new 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 function CP_Lt (Op1, Op2 : Natural) return Boolean;
-- 0 .. 1 6 .. 7 0 6 -- Compare routine for Sort
-- 0 .. 2 5 .. 7 0 5
-- 0 .. 7 0 .. 7 0 4
-- 1 .. 1 6 .. 6 1 6 procedure CP_Move (From : Natural; To : Natural);
-- 1 .. 4 3 .. 6 1 3 -- Move routine for Sort
-- 4 .. 7 0 .. 3 4 0
-- The rule is that the first bit is is obtained by package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt);
-- subtracting the old ending bit from storage_unit - 1.
Set_Component_Bit_Offset Start : Natural;
(Comp, Stop : Natural;
(Storage_Unit_Offset * System_Storage_Unit) + -- Start and stop positions in the component list of the set of
(System_Storage_Unit - 1) - -- components with the same starting position (that constitute
(Start_Bit + CSZ - 1)); -- components in a single machine scalar).
Set_Normalized_First_Bit MaxL : Uint;
(Comp, -- Maximum last bit value of any component in this set
Component_Bit_Offset (Comp) mod
System_Storage_Unit);
end if;
end;
end if;
Next_Component_Or_Discriminant (Comp); MSS : Uint;
end loop; -- 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 -- CP_Lt --
-- same byte offset and processing them together. Same approach is still -----------
-- valid in later versions including Ada 2012.
else function CP_Lt (Op1, Op2 : Natural) return Boolean is
declare begin
Max_Machine_Scalar_Size : constant Uint := return Position (Component_Clause (Comps (Op1))) <
UI_From_Int Position (Component_Clause (Comps (Op2)));
(Standard_Long_Long_Integer_Size); end CP_Lt;
-- We use this as the maximum machine scalar size
Num_CC : Natural; -------------
SSU : constant Uint := UI_From_Int (System_Storage_Unit); -- CP_Move --
-------------
procedure CP_Move (From : Natural; To : Natural) is
begin begin
-- This first loop through components does two things. First it Comps (To) := Comps (From);
-- deals with the case of components with component clauses whose end CP_Move;
-- 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);
if Present (CC) then -- Start of processing for Sort_CC
declare
Fbit : constant Uint := Static_Integer (First_Bit (CC));
Lbit : constant Uint := Static_Integer (Last_Bit (CC));
begin begin
-- Case of component with last bit >= max machine scalar -- 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 begin
-- last bit + 1 is a multiple of storage unit size. -- 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 -- Now we have a group of component clauses from Start to
Error_Msg_N -- Stop whose positions are identical, and MaxL is the
("info: multi-byte field specified with " -- maximum last bit value of any of these components.
& "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;
-- 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 MSS := Max_Machine_Scalar_Size;
Error_Msg_FE while MSS mod 2 = 0
("machine scalar rules not followed for&", and then (MSS / 2) >= SSU
First_Bit (CC), Comp); and then (MSS / 2) > MaxL
loop
MSS := MSS / 2;
end loop;
Error_Msg_Uint_1 := Lbit + 1; -- Here is where we fix up the Component_Bit_Offset value
Error_Msg_Uint_2 := Max_Machine_Scalar_Size; -- to account for the reverse bit order. Some examples of
Error_Msg_F -- what needs to be done for the case of a machine scalar
("\last bit + 1 (^) exceeds maximum machine " -- size of 8 are:
& "scalar size (^)",
First_Bit (CC));
if (Lbit + 1) mod SSU /= 0 then -- First_Bit .. Last_Bit Component_Bit_Offset
Error_Msg_Uint_1 := SSU; -- old new old new
Error_Msg_F
("\and is not a multiple of Storage_Unit (^) "
& "(RM 13.5.1(10))",
First_Bit (CC));
else -- 0 .. 0 7 .. 7 0 7
Error_Msg_Uint_1 := Fbit; -- 0 .. 1 6 .. 7 0 6
Error_Msg_F -- 0 .. 2 5 .. 7 0 5
("\and first bit (^) is non-zero " -- 0 .. 7 0 .. 7 0 4
& "(RM 13.4.1(10))",
First_Bit (CC));
end if;
end if;
-- OK case of machine scalar related component clause, -- 1 .. 1 6 .. 6 1 6
-- For now, just count them. -- 1 .. 4 3 .. 6 1 3
-- 4 .. 7 0 .. 3 4 0
else -- The rule is that the first bit is obtained by subtracting
Num_CC := Num_CC + 1; -- the old ending bit from machine scalar size - 1.
end if;
end;
end if;
Next_Component_Or_Discriminant (Comp); for C in Start .. Stop loop
end 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 LB : constant Uint := Static_Integer (Last_Bit (CC));
-- Position values in the clause, so we can group clauses with NFB : constant Uint := MSS - Uint_1 - LB;
-- the same Position together to determine the relevant machine NLB : constant Uint := NFB + Esize (Comp) - 1;
-- scalar size. Pos : constant Uint := Static_Integer (Position (CC));
Sort_CC : declare begin
Comps : array (0 .. Num_CC) of Entity_Id; if Warn_On_Reverse_Bit_Order then
-- Array to collect component and discriminant entities. The Error_Msg_Uint_1 := MSS;
-- data starts at index 1, the 0'th entry is for the sort Error_Msg_N
-- routine. ("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; if Bytes_Big_Endian then
-- Compare routine for Sort 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); Set_Component_Bit_Offset (Comp, Pos * SSU + NFB);
-- Move routine for Sort 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; procedure Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R : Entity_Id) is
Stop : Natural; Comp : Node_Id;
-- Start and stop positions in the component list of the set of CC : Node_Id;
-- components with the same starting position (that constitute
-- components in a single machine scalar).
MaxL : Uint; begin
-- Maximum last bit value of any component in this set -- 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; Comp := First_Component_Or_Discriminant (R);
-- Corresponding machine scalar size while Present (Comp) loop
CC := Component_Clause (Comp);
----------- -- If component clause is present, then deal with the non-default
-- CP_Lt -- -- bit order case for Ada 95 mode.
-----------
function CP_Lt (Op1, Op2 : Natural) return Boolean is -- We only do this processing for the base type, and in fact that
begin -- is important, since otherwise if there are record subtypes, we
return Position (Component_Clause (Comps (Op1))) < -- could reverse the bits once for each subtype, which is wrong.
Position (Component_Clause (Comps (Op2)));
end CP_Lt;
------------- if Present (CC) and then Ekind (R) = E_Record_Type then
-- CP_Move -- 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 Storage_Unit_Offset : constant Uint :=
begin CFB / System_Storage_Unit;
Comps (To) := Comps (From);
end CP_Move;
-- Start of processing for Sort_CC Start_Bit : constant Uint :=
CFB mod System_Storage_Unit;
begin begin
-- Collect the machine scalar relevant component clauses -- Cases where field goes over storage unit boundary
Num_CC := 0; if Start_Bit + CSZ > System_Storage_Unit then
Comp := First_Component_Or_Discriminant (R);
while Present (Comp) loop
declare
CC : constant Node_Id := Component_Clause (Comp);
begin -- Allow multi-byte field but generate warning
-- 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;
Next_Component_Or_Discriminant (Comp); if Start_Bit mod System_Storage_Unit = 0
end loop; 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 if Bytes_Big_Endian then
Error_Msg_N
Sorting.Sort (Num_CC); ("\bytes are not reversed "
& "(component is big-endian)?V?", CLC);
-- 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 else
exit; Error_Msg_N
("\bytes are not reversed "
& "(component is little-endian)?V?", CLC);
end if; end if;
end loop;
-- Now we have a group of component clauses from Start to -- Do not allow non-contiguous field
-- Stop whose positions are identical, and MaxL is the
-- maximum last bit value of any of these components. else
Error_Msg_N
-- We need to determine the corresponding machine scalar ("attempt to specify non-contiguous field "
-- size. This loop assumes that machine scalar sizes are & "not permitted", CLC);
-- even, and that each possible machine scalar has twice Error_Msg_N
-- as many bits as the next smaller one. ("\caused by non-standard Bit_Order "
& "specified in legacy Ada 95 mode", CLC);
MSS := Max_Machine_Scalar_Size; end if;
while MSS mod 2 = 0
and then (MSS / 2) >= SSU -- Case where field fits in one storage unit
and then (MSS / 2) > MaxL
loop else
MSS := MSS / 2; -- Give warning if suspicious component clause
end loop;
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 -- Here is where we fix up the Component_Bit_Offset value
-- to account for the reverse bit order. Some examples of -- to account for the reverse bit order. Some examples of
-- what needs to be done for the case of a machine scalar -- what needs to be done are:
-- size of 8 are:
-- First_Bit .. Last_Bit Component_Bit_Offset -- First_Bit .. Last_Bit Component_Bit_Offset
-- old new old new -- old new old new
...@@ -730,48 +766,26 @@ package body Sem_Ch13 is ...@@ -730,48 +766,26 @@ package body Sem_Ch13 is
-- 1 .. 4 3 .. 6 1 3 -- 1 .. 4 3 .. 6 1 3
-- 4 .. 7 0 .. 3 4 0 -- 4 .. 7 0 .. 3 4 0
-- The rule is that the first bit is obtained by subtracting -- The rule is that the first bit is is obtained by
-- the old ending bit from machine scalar size - 1. -- subtracting the old ending bit from storage_unit - 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)); Set_Component_Bit_Offset
NFB : constant Uint := MSS - Uint_1 - LB; (Comp,
NLB : constant Uint := NFB + Esize (Comp) - 1; (Storage_Unit_Offset * System_Storage_Unit) +
Pos : constant Uint := Static_Integer (Position (CC)); (System_Storage_Unit - 1) -
(Start_Bit + CSZ - 1));
begin Set_Normalized_First_Bit
if Warn_On_Reverse_Bit_Order then (Comp,
Error_Msg_Uint_1 := MSS; Component_Bit_Offset (Comp) mod
Error_Msg_N System_Storage_Unit);
("info: reverse bit order in machine " & end if;
"scalar of length^?V?", First_Bit (CC)); end;
Error_Msg_Uint_1 := NFB; end if;
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_Component_Bit_Offset (Comp, Pos * SSU + NFB); Next_Component_Or_Discriminant (Comp);
Set_Normalized_First_Bit (Comp, NFB mod SSU); end loop;
end; end Adjust_Record_For_Reverse_Bit_Order_Ada_95;
end loop;
end loop;
end Sort_CC;
end;
end if;
end Adjust_Record_For_Reverse_Bit_Order;
------------------------------------- -------------------------------------
-- Alignment_Check_For_Size_Change -- -- Alignment_Check_For_Size_Change --
......
...@@ -50,8 +50,9 @@ package Sem_Ch13 is ...@@ -50,8 +50,9 @@ package Sem_Ch13 is
procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id); procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id);
-- Called from Freeze where R is a record entity for which reverse bit -- 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 -- order is specified and there is at least one component clause. Note:
-- component positions according to either Ada 95 or Ada 2005 (AI-133). -- 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); procedure Check_Record_Representation_Clause (N : Node_Id);
-- This procedure completes the analysis of a record representation clause -- This procedure completes the analysis of a record representation clause
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment