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>
* sem_ch3.adb (Analyze_Declarations): Correct comments
......
......@@ -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.
......
......@@ -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);
......
......@@ -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,148 +355,31 @@ package body Sem_Ch13 is
Comp : Node_Id;
CC : Node_Id;
begin
-- Processing depends on version of Ada
-- 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.
if Ada_Version < Ada_2005 then
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.
-- 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.
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;
Max_Machine_Scalar_Size : constant Uint :=
UI_From_Int
(Standard_Long_Long_Integer_Size);
-- We use this as the maximum machine scalar size
Start_Bit : constant Uint :=
CFB mod System_Storage_Unit;
Num_CC : Natural;
SSU : constant Uint := UI_From_Int (System_Storage_Unit);
begin
-- Cases where field goes over storage unit boundary
if Start_Bit + CSZ > System_Storage_Unit then
-- 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
("info: multi-byte field specified with "
& "non-standard Bit_Order?V?", CLC);
if Bytes_Big_Endian then
Error_Msg_N
("\bytes are not reversed "
& "(component is big-endian)?V?", CLC);
else
Error_Msg_N
("\bytes are not reversed "
& "(component is little-endian)?V?", CLC);
end if;
-- Do not allow non-contiguous field
-- 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.
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);
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 are:
-- 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
-- 1 .. 1 6 .. 6 1 6
-- 1 .. 4 3 .. 6 1 3
-- 4 .. 7 0 .. 3 4 0
-- 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_Normalized_First_Bit
(Comp,
Component_Bit_Offset (Comp) mod
System_Storage_Unit);
end if;
end;
if Ada_Version < Ada_2005 and then Debug_Flag_Dot_P then
Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R);
return;
end if;
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. Same approach is still
-- valid in later versions including Ada 2012.
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);
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
......@@ -769,9 +656,136 @@ package body Sem_Ch13 is
end loop;
end loop;
end Sort_CC;
end Adjust_Record_For_Reverse_Bit_Order;
------------------------------------------------
-- Adjust_Record_For_Reverse_Bit_Order_Ada_95 --
------------------------------------------------
procedure Adjust_Record_For_Reverse_Bit_Order_Ada_95 (R : Entity_Id) is
Comp : Node_Id;
CC : Node_Id;
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.
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.
-- 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.
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;
Start_Bit : constant Uint :=
CFB mod System_Storage_Unit;
begin
-- Cases where field goes over storage unit boundary
if Start_Bit + CSZ > System_Storage_Unit then
-- 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
("info: multi-byte field specified with "
& "non-standard Bit_Order?V?", CLC);
if Bytes_Big_Endian then
Error_Msg_N
("\bytes are not reversed "
& "(component is big-endian)?V?", CLC);
else
Error_Msg_N
("\bytes are not reversed "
& "(component is little-endian)?V?", CLC);
end if;
-- 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 are:
-- 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
-- 1 .. 1 6 .. 6 1 6
-- 1 .. 4 3 .. 6 1 3
-- 4 .. 7 0 .. 3 4 0
-- 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_Normalized_First_Bit
(Comp,
Component_Bit_Offset (Comp) mod
System_Storage_Unit);
end if;
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 --
......
......@@ -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
......
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