Skip to content

R
riscv-gcc-1
Commit 637a41a5 by Arnaud Charlet
Options

[multiple changes] 

2014-01-21  Robert Dewar  <dewar@adacore.com>

	* checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting.

2014-01-21  Pascal Obry  <obry@adacore.com>

	* projects.texi: Minor typo fix.

2014-01-21  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Check_Component_Storage_Order): If a record type
	has an explicit Scalar_Storage_Order attribute definition clause,
	reject any component that itself is of a composite type and does
	not have one.

2014-01-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Generate_Parent_Reference): Make public so it
	can be used to generate proper cross-reference information for
	the parent units of proper bodies.

2014-01-21  Thomas Quinot  <quinot@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity): For a modular
	type that represents a bit packed array type, propagate the
	reverse storage order flag to the generated wrapper record.
	* exp_pakd.adb (Expand_Packed_Element_Set,
	Expand_Packed_Element_Reference): No byte swapping required in
	the front-end for the case of a reverse storage order array,
	as this is now handled uniformly in the back-end.  However we
	still need to swap back an extracted element if it is itself a
	nested composite with reverse storage order.

From-SVN: r206890
parent 497716fe
Showing with 149 additions and 152 deletions
gcc/ada/ChangeLog
2014-01-21 Robert Dewar <dewar@adacore.com>
* checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting.
* gcc-interface/Makefile.in: clean up target pairs.
2014-01-21 Pascal Obry <obry@adacore.com>
* projects.texi: Minor typo fix.
2014-01-21 Thomas Quinot <quinot@adacore.com>
* freeze.adb (Check_Component_Storage_Order): If a record type
has an explicit Scalar_Storage_Order attribute definition clause,
reject any component that itself is of a composite type and does
not have one.
2014-01-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Generate_Parent_Reference): Make public so it
can be used to generate proper cross-reference information for
the parent units of proper bodies.
2014-01-21 Thomas Quinot <quinot@adacore.com>
* exp_pakd.adb (Expand_Packed_Element_Set,
Expand_Packed_Element_Reference): No byte swapping required in
the front-end for the case of a reverse storage order array,
as this is now handled uniformly in the back-end. However we
still need to swap back an extracted element if it is itself a
nested composite with reverse storage order.
2014-01-21 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_External_Property): Add processing for "others".
......
gcc/ada/exp_pakd.adb
......@@ -1378,12 +1378,6 @@ package body Exp_Pakd is
-- contains the value. Otherwise Rhs_Val_Known is set False, and
-- the Rhs_Val is undefined.
Require_Byte_Swapping : Boolean := False;
-- True if byte swapping required, for the Reverse_Storage_Order case
-- when the packed array is a free-standing object. (If it is part
-- of a composite type, and therefore potentially not aligned on a byte
-- boundary, the swapping is done by the back-end).
function Get_Shift return Node_Id;
-- Function used to get the value of Shift, making sure that it
-- gets duplicated if the function is called more than once.
......@@ -1562,25 +1556,8 @@ package body Exp_Pakd is
-- array type on Obj to get lost. So we save the type of Obj, and
-- make sure it is reset properly.
declare
T : constant Entity_Id := Etype (Obj);
begin
New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
Set_Etype (Obj, T);
Set_Etype (New_Lhs, T);
Set_Etype (New_Rhs, T);
if Reverse_Storage_Order (Base_Type (Atyp))
and then Esize (T) > 8
and then not In_Reverse_Storage_Order_Object (Obj)
then
Require_Byte_Swapping := True;
New_Rhs := Byte_Swap (New_Rhs,
Left_Justify => Bytes_Big_Endian,
Right_Justify => not Bytes_Big_Endian);
end if;
end;
New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
-- First we deal with the "and"
......@@ -1703,13 +1680,6 @@ package body Exp_Pakd is
Set_Etype (New_Rhs, Etype (Left_Opnd (New_Rhs)));
end if;
-- If New_Rhs has been byte swapped, need to convert Or_Rhs
-- to the return type of the byte swapping function now.
if Require_Byte_Swapping then
Or_Rhs := Unchecked_Convert_To (Etype (New_Rhs), Or_Rhs);
end if;
New_Rhs :=
Make_Op_Or (Loc,
Left_Opnd => New_Rhs,
......@@ -1717,15 +1687,6 @@ package body Exp_Pakd is
end;
end if;
if Require_Byte_Swapping then
Set_Etype (New_Rhs, Etype (Obj));
New_Rhs :=
Unchecked_Convert_To (Etype (Obj),
Byte_Swap (New_Rhs,
Left_Justify => not Bytes_Big_Endian,
Right_Justify => Bytes_Big_Endian));
end if;
-- Now do the rewrite
Rewrite (N,
......@@ -2043,11 +2004,6 @@ package body Exp_Pakd is
Lit : Node_Id;
Arg : Node_Id;
Byte_Swapped : Boolean;
-- Set true if bytes were swapped for the purpose of extracting the
-- element, in which case we must swap back if the component type is
-- a composite type with reverse scalar storage order.
begin
-- If the node is an actual in a call, the prefix has not been fully
-- expanded, to account for the additional expansion for in-out actuals
......@@ -2106,23 +2062,6 @@ package body Exp_Pakd is
Lit := Make_Integer_Literal (Loc, Cmask);
Set_Print_In_Hex (Lit);
-- Byte swapping required for the Reverse_Storage_Order case, but
-- only for a free-standing object (see note on Require_Byte_Swapping
-- in Expand_Bit_Packed_Element_Set).
if Reverse_Storage_Order (Atyp)
and then Esize (Atyp) > 8
and then not In_Reverse_Storage_Order_Object (Obj)
then
Obj := Byte_Swap (Obj,
Left_Justify => Bytes_Big_Endian,
Right_Justify => not Bytes_Big_Endian);
Byte_Swapped := True;
else
Byte_Swapped := False;
end if;
-- We generate a shift right to position the field, followed by a
-- masking operation to extract the bit field, and we finally do an
-- unchecked conversion to convert the result to the required target.
......@@ -2137,12 +2076,16 @@ package body Exp_Pakd is
Make_Op_And (Loc,
Left_Opnd => Make_Shift_Right (Obj, Shift),
Right_Opnd => Lit);
-- Swap back if necessary
Set_Etype (Arg, Ctyp);
if Byte_Swapped
-- Component extraction is performed on a native endianness scalar
-- value: if Atyp has reverse storage order, then it has been byte
-- swapped, and if the component being extracted is itself of a
-- composite type with reverse storage order, then we need to swap
-- it back to its expected endianness after extraction.
if Reverse_Storage_Order (Atyp)
and then Esize (Atyp) > 8
and then (Is_Record_Type (Ctyp) or else Is_Array_Type (Ctyp))
and then Reverse_Storage_Order (Ctyp)
then
......
gcc/ada/freeze.adb
......@@ -1083,6 +1083,10 @@ package body Freeze is
-- Set True for the record case, when Comp starts on a byte boundary
-- (in which case it is allowed to have different storage order).
Comp_SSO_Differs : Boolean;
-- Set True when the component is a nested composite, and it does not
-- have the same scalar storage order as Encl_Type.
Component_Aliased : Boolean;
begin
......@@ -1136,28 +1140,42 @@ package body Freeze is
-- attribute on Comp_Type if composite.
elsif Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
Comp_SSO_Differs :=
Reverse_Storage_Order (Encl_Type)
/=
Reverse_Storage_Order (Comp_Type);
if Present (Comp) and then Chars (Comp) = Name_uParent then
if Reverse_Storage_Order (Encl_Type)
/=
Reverse_Storage_Order (Comp_Type)
then
if Comp_SSO_Differs then
Error_Msg_N
("record extension must have same scalar storage order as "
& "parent", Err_Node);
end if;
elsif No (ADC) then
elsif No (Comp_ADC) then
Error_Msg_N ("nested composite must have explicit scalar "
& "storage order", Err_Node);
elsif (Reverse_Storage_Order (Encl_Type)
/=
Reverse_Storage_Order (Comp_Type))
and then not Comp_Byte_Aligned
then
Error_Msg_N
("type of non-byte-aligned component must have same scalar "
& "storage order as enclosing composite", Err_Node);
elsif Comp_SSO_Differs then
-- Component SSO differs from enclosing composite:
-- Reject if component is a packed array, as it may be represented
-- as a scalar internally.
if Is_Packed (Comp_Type) then
Error_Msg_N
("type of packed component must have same scalar "
& "storage order as enclosing composite", Err_Node);
-- Reject if not byte aligned
elsif not Comp_Byte_Aligned then
Error_Msg_N
("type of non-byte-aligned component must have same scalar "
& "storage order as enclosing composite", Err_Node);
end if;
end if;
-- Enclosing type has explicit SSO, non-composite component must not
......
gcc/ada/gcc-interface/Makefile.in
......@@ -562,8 +562,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
s-vxwext.adb<s-vxwext-rtp.adb \
s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
system.ads<system-vxworks-$(ARCH_STR)-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
else
ifeq ($(strip $(filter-out rtp-smp,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
......@@ -573,7 +571,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
system.ads<system-vxworks-$(ARCH_STR)-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
EXTRA_LIBGNAT_OBJS+=affinity.o
else
ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
......@@ -603,7 +600,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
system.ads<system-vxworks-ppc.ads
endif
endif
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
EXTRA_LIBGNAT_OBJS+=sigtramp-ppcvxw.o
endif
endif
......@@ -650,7 +647,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(target_cpu) $(target_vendor)
mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
indepsw.adb<indepsw-gnu.adb
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_OBJS+=sigtramp-ppcvxw.o
......@@ -714,7 +711,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(target_cpu) $(target_vendo
mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
indepsw.adb<indepsw-gnu.adb
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o s-vxwexc.o
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o sigtramp-ppcvxw.o
......@@ -736,8 +733,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
LIBGNAT_TARGET_PAIRS = \
a-elchha.adb<a-elchha-vxworks-ppc-full.adb \
a-intnam.ads<a-intnam-vxworks.ads \
a-sytaco.ads<1asytaco.ads \
a-sytaco.adb<1asytaco.adb \
a-numaux.ads<a-numaux-vxworks.ads \
g-io.adb<g-io-vxworks-ppc-cert.adb \
s-inmaop.adb<s-inmaop-vxworks.adb \
s-interr.adb<s-interr-hwint.adb \
......@@ -747,6 +743,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
s-osinte.ads<s-osinte-vxworks.ads \
s-osprim.adb<s-osprim-vxworks.adb \
s-parame.ads<s-parame-ae653.ads \
s-parame.adb<s-parame-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
......@@ -754,17 +751,20 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
s-vxwext.adb<s-vxwext-noints.adb \
s-vxwext.ads<s-vxwext-vthreads.ads \
s-vxwork.ads<s-vxwork-x86.ads \
system.ads<system-vxworks-x86.ads \
$(ATOMICS_TARGET_PAIRS) \
$(X86_TARGET_PAIRS) \
system.ads<system-vxworks-x86.ads
$(ATOMICS_BUILTINS_TARGET_PAIRS)
TOOLS_TARGET_PAIRS=\
mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
indepsw.adb<indepsw-gnu.adb
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o # sigtramp-ppcvxw.o
GNATRTL_SOCKETS_OBJS =
# Extra pairs for the vthreads runtime
ifeq ($(strip $(filter-out vthreads,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
......@@ -887,7 +887,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
system.ads<system-vxworks-x86-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
else
ifeq ($(strip $(filter-out rtp-smp, $(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
......@@ -897,7 +896,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
system.ads<system-vxworks-x86-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
EXTRA_LIBGNAT_OBJS+=affinity.o
else
ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
......@@ -925,7 +923,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
endif
endif
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
endif
endif
EXTRA_GNATRTL_TASKING_OBJS += s-vxwork.o s-vxwext.o
......@@ -2421,7 +2419,7 @@ ADA_EXCLUDE_SRCS =\
s-po32gl.adb s-po32gl.ads \
s-stache.adb s-stache.ads \
s-thread.ads \
s-vxwexc.adb s-vxwexc.ads s-vxwext.adb s-vxwext.ads \
s-vxwext.adb s-vxwext.ads \
s-win32.ads s-winext.ads \
g-regist.adb g-regist.ads g-sse.ads g-ssvety.ads \
i-vxwoio.adb i-vxwoio.ads i-vxwork.ads \
......
gcc/ada/projects.texi
......@@ -3171,8 +3171,8 @@ The following packages are currently supported in project files
@b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
package @code{Builder}.
@item ^Gnatls^Gnatls^
This package the options to use when invoking @command{gnatls} via the
@command{gnat} driver.
This package specifies the options to use when invoking @command{gnatls}
via the @command{gnat} driver.
@item ^Gnatstub^Gnatstub^
This package specifies the options used when calling the tool
@command{gnatstub} via the @command{gnat} driver. Its attributes
......
gcc/ada/sem_ch10.adb
......@@ -105,6 +105,11 @@ package body Sem_Ch10 is
-- N is the compilation unit whose list of context items receives the
-- implicit with_clauses.
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);
-- Generate cross-reference information for the parents of child units
-- and of subunits. N is a defining_program_unit_name, and P_Id is the
-- immediate parent scope.
function Get_Parent_Entity (Unit : Node_Id) return Entity_Id;
-- Get defining entity of parent unit of a child unit. In most cases this
-- is the defining entity of the unit, but for a child instance whose
......@@ -261,10 +266,6 @@ package body Sem_Ch10 is
-- Spec_Context_Items to that of the spec. Parent packages are not
-- examined for documentation purposes.
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);
-- Generate cross-reference information for the parents of child units.
-- N is a defining_program_unit_name, and P_Id is the immediate parent.
---------------------------
-- Check_Redundant_Withs --
---------------------------
......@@ -598,45 +599,6 @@ package body Sem_Ch10 is
end loop;
end Check_Redundant_Withs;
--------------------------------
-- Generate_Parent_References --
--------------------------------
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id) is
Pref : Node_Id;
P_Name : Entity_Id := P_Id;
begin
Pref := Name (Parent (Defining_Entity (N)));
if Nkind (Pref) = N_Expanded_Name then
-- Done already, if the unit has been compiled indirectly as
-- part of the closure of its context because of inlining.
return;
end if;
while Nkind (Pref) = N_Selected_Component loop
Change_Selected_Component_To_Expanded_Name (Pref);
Set_Entity (Pref, P_Name);
Set_Etype (Pref, Etype (P_Name));
Generate_Reference (P_Name, Pref, 'r');
Pref := Prefix (Pref);
P_Name := Scope (P_Name);
end loop;
-- The guard here on P_Name is to handle the error condition where
-- the parent unit is missing because the file was not found.
if Present (P_Name) then
Set_Entity (Pref, P_Name);
Set_Etype (Pref, Etype (P_Name));
Generate_Reference (P_Name, Pref, 'r');
Style.Check_Identifier (Pref, P_Name);
end if;
end Generate_Parent_References;
-- Start of processing for Analyze_Compilation_Unit
begin
......@@ -865,9 +827,9 @@ package body Sem_Ch10 is
if Nkind (Defining_Unit_Name (Specification (Unit_Node))) =
N_Defining_Program_Unit_Name
then
Generate_Parent_References (
Specification (Unit_Node),
Scope (Defining_Entity (Unit (Lib_Unit))));
Generate_Parent_References
(Specification (Unit_Node),
Scope (Defining_Entity (Unit (Lib_Unit))));
end if;
end if;
......@@ -906,8 +868,8 @@ package body Sem_Ch10 is
-- Set the entities of all parents in the program_unit_name
Generate_Parent_References (
Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
Generate_Parent_References
(Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
end if;
-- All components of the context: with-clauses, library unit, ancestors
......@@ -2326,6 +2288,7 @@ package body Sem_Ch10 is
end if;
end if;
Generate_Parent_References (Unit (N), Par_Unit);
Analyze (Proper_Body (Unit (N)));
Remove_Context (N);
......@@ -3056,6 +3019,49 @@ package body Sem_Ch10 is
end if;
end Expand_With_Clause;
--------------------------------
-- Generate_Parent_References --
--------------------------------
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id) is
Pref : Node_Id;
P_Name : Entity_Id := P_Id;
begin
if Nkind (N) = N_Subunit then
Pref := Name (N);
else
Pref := Name (Parent (Defining_Entity (N)));
end if;
if Nkind (Pref) = N_Expanded_Name then
-- Done already, if the unit has been compiled indirectly as
-- part of the closure of its context because of inlining.
return;
end if;
while Nkind (Pref) = N_Selected_Component loop
Change_Selected_Component_To_Expanded_Name (Pref);
Set_Entity (Pref, P_Name);
Set_Etype (Pref, Etype (P_Name));
Generate_Reference (P_Name, Pref, 'r');
Pref := Prefix (Pref);
P_Name := Scope (P_Name);
end loop;
-- The guard here on P_Name is to handle the error condition where
-- the parent unit is missing because the file was not found.
if Present (P_Name) then
Set_Entity (Pref, P_Name);
Set_Etype (Pref, Etype (P_Name));
Generate_Reference (P_Name, Pref, 'r');
Style.Check_Identifier (Pref, P_Name);
end if;
end Generate_Parent_References;
-----------------------
-- Get_Parent_Entity --
-----------------------
......
gcc/ada/sem_ch4.adb
......@@ -4652,15 +4652,16 @@ package body Sem_Ch4 is
Set_Etype (Sel, Etype (Comp));
Set_Etype (N, Etype (Comp));
-- Emit appropriate message. Gigi will replace the node
-- subsequently with the appropriate Raise.
-- Emit appropriate message. The node will be replaced
-- by an appropriate raise statement.
-- In SPARK mode, this is made into an error to simplify
-- the processing of the formal verification backend.
-- Note that in SPARK mode, as with all calls to apply a
-- compile time constraint error, this will be made into
-- an error to simplify the processing of the formal
-- verification backend.
Error_Msg_Warn := SPARK_Mode /= On;
Apply_Compile_Time_Constraint_Error
(N, "component not present in }<<",
(N, "component not present in }??",
CE_Discriminant_Check_Failed,
Ent => Prefix_Type, Rep => False);
......
gcc/ada/sem_util.ads
......@@ -122,7 +122,7 @@ package Sem_Util is
-- is present, this is used instead. Warn is normally False. If it is
-- True then the message is treated as a warning even though it does
-- not end with a ? (this is used when the caller wants to parameterize
-- whether an error or warning is given.
-- whether an error or warning is given).
function Async_Readers_Enabled (Id : Entity_Id) return Boolean;
-- Given the entity of an abstract state or a variable, determine whether
......
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