+2010-10-08 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_aggr.adb (Resolve_Array_Aggregate): If the expression in an
+ others choice is a literal analyze it now to enable later optimizations.
+ * exp_aggr.adb (Expand_Record_Aggregate): An aggregate with static size
+ and components can be handled by the backend even if it is of a limited
+ type.
+
+2010-10-08 Arnaud Charlet <charlet@adacore.com>
+
+ * a-rttiev.adb (task Timer): Since this package may be elaborated
+ before System.Interrupt, we need to call Setup_Interrupt_Mask
+ explicitly to ensure that this task has the proper signal mask.
+
+2010-10-08 Robert Dewar <dewar@adacore.com>
+
+ * freeze.adb (Freeze_Entity): For array case, move some processing for
+ pragma Pack, Component_Size clause and atomic/volatile components here
+ instead of trying to do the job in Sem_Ch13 and Freeze.
+ * layout.adb: Use new Addressable function
+ * sem_ch13.adb (Analyze_Attribute_Representation_Clause, case
+ Component_Size): Move some handling to freeze point in
+ Freeze.Freeze_Entity.
+ * sem_prag.adb (Analyze_pragma, case Pack): Move some handling to
+ freeze point in Freese.Freeze_Entity.
+ * sem_util.ads, sem_util.adb (Addressable): New function.
+
2010-10-08 Robert Dewar <dewar@adacore.com>
* sprint.adb: Minor reformatting.
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with System.Task_Primitives.Operations;
with System.Tasking.Utilities;
with System.Soft_Links;
+with System.Interrupt_Management.Operations;
with Ada.Containers.Doubly_Linked_Lists;
pragma Elaborate_All (Ada.Containers.Doubly_Linked_Lists);
begin
System.Tasking.Utilities.Make_Independent;
+ -- Since this package may be elaborated before System.Interrupt,
+ -- we need to call Setup_Interrupt_Mask explicitly to ensure that
+ -- this task has the proper signal mask.
+
+ System.Interrupt_Management.Operations.Setup_Interrupt_Mask;
+
-- We await the call to Start to ensure that Event_Queue_Lock has been
-- initialized by the package executable part prior to accessing it in
-- the loop. The task is activated before the first statement of the
then
null;
+ elsif Is_Entity_Name (Expression (Expr))
+ and then Present (Entity (Expression (Expr)))
+ and then Ekind (Entity (Expression (Expr))) =
+ E_Enumeration_Literal
+ then
+ null;
+
elsif Nkind (Expression (Expr)) /= N_Aggregate
or else not Compile_Time_Known_Aggregate (Expression (Expr))
or else Expansion_Delayed (Expression (Expr))
C := First (Comps);
while Present (C) loop
+
+ -- If the component has box initialization, expansion is needed
+ -- and component is not ready for backend.
+
+ if Box_Present (C) then
+ return True;
+ end if;
+
if Nkind (Expression (C)) = N_Qualified_Expression then
Expr_Q := Expression (Expression (C));
else
end if;
-- Ada 2005 (AI-318-2): We need to convert to assignments if components
- -- are build-in-place function calls. This test could be more specific,
- -- but doing it for all inherently limited aggregates seems harmless.
- -- The assignments will turn into build-in-place function calls (see
- -- Make_Build_In_Place_Call_In_Assignment).
+ -- are build-in-place function calls. The assignments will each turn
+ -- into a build-in-place function call. If components are all static,
+ -- we can pass the aggregate to the backend regardless of limitedness.
+
+ -- Extension aggregates, aggregates in extended return statements, and
+ -- aggregates for C++ imported types must be expanded.
if Ada_Version >= Ada_05 and then Is_Inherently_Limited_Type (Typ) then
- Convert_To_Assignments (N, Typ);
+ if Nkind (Parent (N)) /= N_Object_Declaration then
+ Convert_To_Assignments (N, Typ);
+
+ elsif Nkind (N) = N_Extension_Aggregate
+ or else Convention (Typ) = Convention_CPP
+ then
+ Convert_To_Assignments (N, Typ);
+
+ elsif not Size_Known_At_Compile_Time (Typ)
+ or else Component_Not_OK_For_Backend
+ or else not Static_Components
+ then
+ Convert_To_Assignments (N, Typ);
+
+ else
+ Set_Compile_Time_Known_Aggregate (N);
+ Set_Expansion_Delayed (N, False);
+ end if;
-- Gigi doesn't handle properly temporaries of variable size
-- so we generate it in the front-end
if Is_Array_Type (E) then
declare
- Ctyp : constant Entity_Id := Component_Type (E);
+ FS : constant Entity_Id := First_Subtype (E);
+ Ctyp : constant Entity_Id := Component_Type (E);
+ Clause : Entity_Id;
Non_Standard_Enum : Boolean := False;
-- Set true if any of the index types is an enumeration type
begin
if (Is_Packed (E) or else Has_Pragma_Pack (E))
- and then not Has_Atomic_Components (E)
and then Known_Static_RM_Size (Ctyp)
+ and then not Has_Component_Size_Clause (E)
then
Csiz := UI_Max (RM_Size (Ctyp), 1);
if Present (Comp_Size_C)
and then Has_Pragma_Pack (Ent)
+ and then Warn_On_Redundant_Constructs
then
Error_Msg_Sloc := Sloc (Comp_Size_C);
Error_Msg_NE
Error_Msg_N
("\?explicit component size given#!",
Pack_Pragma);
+ Set_Is_Packed (Base_Type (Ent), False);
+ Set_Is_Bit_Packed_Array (Base_Type (Ent), False);
end if;
-- Set component size if not already set by a
-- a representation characteristic, and this
-- request may be ignored.
- Set_Is_Packed (Base_Type (E), False);
+ Set_Is_Packed (Base_Type (E), False);
+ Set_Is_Bit_Packed_Array (Base_Type (E), False);
- -- In all other cases, packing is indeed needed
+ if Known_Static_Esize (Component_Type (E))
+ and then Esize (Component_Type (E)) = Csiz
+ then
+ Set_Has_Non_Standard_Rep
+ (Base_Type (E), False);
+ end if;
+
+ -- In all other cases, packing is indeed needed
else
- Set_Has_Non_Standard_Rep (Base_Type (E));
- Set_Is_Bit_Packed_Array (Base_Type (E));
- Set_Is_Packed (Base_Type (E));
+ Set_Has_Non_Standard_Rep (Base_Type (E), True);
+ Set_Is_Bit_Packed_Array (Base_Type (E), True);
+ Set_Is_Packed (Base_Type (E), True);
end if;
end;
end if;
end;
+ -- Check for Atomic_Components or Aliased with unsuitable
+ -- packing or explicit component size clause given.
+
+ if (Has_Atomic_Components (E)
+ or else Has_Aliased_Components (E))
+ and then (Has_Component_Size_Clause (E)
+ or else Is_Packed (E))
+ then
+ Alias_Atomic_Check : declare
+
+ procedure Complain_CS (T : String);
+ -- Outputs error messages for incorrect CS clause or
+ -- pragma Pack for aliased or atomic components (T is
+ -- "aliased" or "atomic");
+
+ -----------------
+ -- Complain_CS --
+ -----------------
+
+ procedure Complain_CS (T : String) is
+ begin
+ if Has_Component_Size_Clause (E) then
+ Clause :=
+ Get_Attribute_Definition_Clause
+ (FS, Attribute_Component_Size);
+
+ if Known_Static_Esize (Ctyp) then
+ Error_Msg_N
+ ("incorrect component size for "
+ & T & " components", Clause);
+ Error_Msg_Uint_1 := Esize (Ctyp);
+ Error_Msg_N
+ ("\only allowed value is^", Clause);
+
+ else
+ Error_Msg_N
+ ("component size cannot be given for "
+ & T & " components", Clause);
+ end if;
+
+ else
+ Error_Msg_N
+ ("cannot pack " & T & " components",
+ Get_Rep_Pragma (FS, Name_Pack));
+ end if;
+
+ return;
+ end Complain_CS;
+
+ -- Start of processing for Alias_Atomic_Check
+
+ begin
+ -- Case where component size has no effect
+
+ if Known_Static_Esize (Ctyp)
+ and then Known_Static_RM_Size (Ctyp)
+ and then Esize (Ctyp) = RM_Size (Ctyp)
+ and then Esize (Ctyp) mod 8 = 0
+ then
+ null;
+
+ elsif Has_Aliased_Components (E)
+ or else Is_Aliased (Ctyp)
+ then
+ Complain_CS ("aliased");
+
+ elsif Has_Atomic_Components (E)
+ or else Is_Atomic (Ctyp)
+ then
+ Complain_CS ("atomic");
+ end if;
+ end Alias_Atomic_Check;
+ end if;
+
+ -- Warn for case of atomic type
+
+ Clause := Get_Rep_Pragma (FS, Name_Atomic);
+
+ if Present (Clause)
+ and then not Addressable (Component_Size (FS))
+ then
+ Error_Msg_NE
+ ("non-atomic components of type& may not be "
+ & "accessible by separate tasks?", Clause, E);
+
+ if Has_Component_Size_Clause (E) then
+ Error_Msg_Sloc :=
+ Sloc
+ (Get_Attribute_Definition_Clause
+ (FS, Attribute_Component_Size));
+ Error_Msg_N
+ ("\because of component size clause#?",
+ Clause);
+
+ elsif Has_Pragma_Pack (E) then
+ Error_Msg_Sloc :=
+ Sloc (Get_Rep_Pragma (FS, Name_Pack));
+ Error_Msg_N
+ ("\because of pragma Pack#?", Clause);
+ end if;
+ end if;
+
-- Processing that is done only for subtypes
else
-- natural boundary of size.
elsif Size_Incl_EP /= Size_Excl_EP
- and then
- (Size_Excl_EP = 8 or else
- Size_Excl_EP = 16 or else
- Size_Excl_EP = 32 or else
- Size_Excl_EP = 64)
+ and then Addressable (Size_Excl_EP)
then
Actual_Size := Size_Excl_EP;
Actual_Lo := Loval_Excl_EP;
then
declare
S : constant Uint := Esize (CT);
-
begin
- if S = 8 or else
- S = 16 or else
- S = 32 or else
- S = 64
- then
- Set_Component_Size (E, Esize (CT));
+ if Addressable (S) then
+ Set_Component_Size (E, S);
end if;
end;
end if;
Expander_Mode_Save_And_Set (False);
Full_Analysis := False;
Analyze (Expr);
+
+ -- If the expression is a literal, propagate this info
+ -- to the expression in the association, to enable some
+ -- optimizations downstream.
+
+ if Is_Entity_Name (Expr)
+ and then Present (Entity (Expr))
+ and then Ekind (Entity (Expr)) = E_Enumeration_Literal
+ then
+ Analyze_And_Resolve
+ (Expression (Assoc), Component_Typ);
+ end if;
+
Full_Analysis := Save_Analysis;
Expander_Mode_Restore;
Biased : Boolean;
New_Ctyp : Entity_Id;
Decl : Node_Id;
- Ignore : Boolean := False;
-
- procedure Complain_CS (T : String);
- -- Outputs error messages for incorrect CS clause for aliased or
- -- atomic components (T is "aliased" or "atomic");
-
- -----------------
- -- Complain_CS --
- -----------------
-
- procedure Complain_CS (T : String) is
- begin
- if Known_Static_Esize (Ctyp) then
- Error_Msg_N
- ("incorrect component size for " & T & " components", N);
- Error_Msg_Uint_1 := Esize (Ctyp);
- Error_Msg_N ("\only allowed value is^", N);
-
- else
- Error_Msg_N
- ("component size cannot be given for " & T & " components",
- N);
- end if;
-
- return;
- end Complain_CS;
-
- -- Start of processing for Component_Size_Case
begin
if not Is_Array_Type (U_Ent) then
Error_Msg_N
("component size clause for& previously given", Nam);
+ elsif Rep_Item_Too_Early (Btype, N) then
+ null;
+
elsif Csize /= No_Uint then
Check_Size (Expr, Ctyp, Csize, Biased);
- -- Case where component size has no effect
-
- if Known_Static_Esize (Ctyp)
- and then Known_Static_RM_Size (Ctyp)
- and then Esize (Ctyp) = RM_Size (Ctyp)
- and then (Esize (Ctyp) = 8 or else
- Esize (Ctyp) = 16 or else
- Esize (Ctyp) = 32 or else
- Esize (Ctyp) = 64)
- then
- Ignore := True;
-
- -- Cannot give component size for aliased/atomic components
-
- elsif Has_Aliased_Components (Btype)
- or else Is_Aliased (Ctyp)
- then
- Complain_CS ("aliased");
-
- elsif Has_Atomic_Components (Btype)
- or else Is_Atomic (Ctyp)
- then
- Complain_CS ("atomic");
-
- -- Warn for case of atomic type
-
- elsif Is_Atomic (Btype) then
- Error_Msg_NE
- ("non-atomic components of type& may not be accessible "
- & "by separate tasks?", N, Btype);
- end if;
-
-- For the biased case, build a declaration for a subtype
-- that will be used to represent the biased subtype that
-- reflects the biased representation of components. We need
end if;
Set_Has_Component_Size_Clause (Btype, True);
-
- if not Ignore then
- Set_Has_Non_Standard_Rep (Btype, True);
- end if;
+ Set_Has_Non_Standard_Rep (Btype, True);
end if;
end Component_Size_Case;
E : Entity_Id;
D : Node_Id;
K : Node_Kind;
- Ctyp : Entity_Id;
begin
Check_Ada_83_Warning;
if Prag_Id = Pragma_Atomic_Components then
Set_Has_Atomic_Components (E);
-
- if Is_Packed (E) then
- Set_Is_Packed (E, False);
-
- if Is_Array_Type (E) then
- Ctyp := Component_Type (E);
- else
- Ctyp := Component_Type (Etype (E));
- end if;
-
- if not (Known_Static_Esize (Ctyp)
- and then Known_Static_RM_Size (Ctyp)
- and then Esize (Ctyp) = RM_Size (Ctyp))
- then
- Error_Pragma_Arg
- ("cannot pack atomic components", Arg1);
- end if;
- end if;
end if;
else
Record_Rep_Item (Proc_Id, N);
end Implemented;
- -----------------------
+ ----------------------
-- Implicit_Packing --
- -----------------------
+ ----------------------
-- pragma Implicit_Packing;
if Known_Static_Esize (Ctyp)
and then Known_Static_RM_Size (Ctyp)
and then Esize (Ctyp) = RM_Size (Ctyp)
- and then (Esize (Ctyp) = 8 or else
- Esize (Ctyp) = 16 or else
- Esize (Ctyp) = 32 or else
- Esize (Ctyp) = 64)
+ and then Addressable (Esize (Ctyp))
then
Ignore := True;
-
- -- Pack not allowed for aliased/atomic components
-
- elsif Has_Aliased_Components (Base_Type (Typ)) then
- Error_Pragma ("cannot pack aliased components");
-
- elsif Has_Atomic_Components (Typ)
- or else Is_Atomic (Component_Type (Typ))
- then
- Error_Pragma ("cannot pack atomic components");
-
- -- Warn for cases of packing non-atomic components of atomic
-
- elsif Is_Atomic (Typ) then
- Error_Msg_NE
- ("non-atomic components of type& may not be accessible "
- & "by separate tasks?", N, Typ);
end if;
- -- If we had an explicit component size given, then we do not
- -- let Pack override this given size. We also give a warning
- -- that Pack is being ignored unless we can tell for sure that
- -- the Pack would not have had any effect anyway.
-
- if Has_Component_Size_Clause (Typ) then
- if Known_Static_RM_Size (Component_Type (Typ))
- and then
- RM_Size (Component_Type (Typ)) = Component_Size (Typ)
- then
- null;
- else
- Error_Pragma
- ("?pragma% ignored, explicit component size given");
- end if;
-
- -- If no prior array component size given, Pack is effective
+ -- Process OK pragma Pack. Note that if there is a separate
+ -- component clause present, the Pack will be cancelled. This
+ -- processing is in Freeze.
- else
- if not Rep_Item_Too_Late (Typ, N) then
+ if not Rep_Item_Too_Late (Typ, N) then
- -- In the context of static code analysis, we do not need
- -- complex front-end expansions related to pragma Pack,
- -- so disable handling of pragma Pack in this case.
+ -- In the context of static code analysis, we do not need
+ -- complex front-end expansions related to pragma Pack,
+ -- so disable handling of pragma Pack in this case.
- if CodePeer_Mode then
- null;
+ if CodePeer_Mode then
+ null;
- -- For normal non-VM target, do the packing
+ -- For normal non-VM target, do the packing
- elsif VM_Target = No_VM then
- if not Ignore then
- Set_Is_Packed (Base_Type (Typ));
- Set_Has_Non_Standard_Rep (Base_Type (Typ));
- end if;
+ elsif VM_Target = No_VM then
+ if not Ignore then
+ Set_Is_Packed (Base_Type (Typ));
+ Set_Has_Non_Standard_Rep (Base_Type (Typ));
+ end if;
- Set_Has_Pragma_Pack (Base_Type (Typ));
+ Set_Has_Pragma_Pack (Base_Type (Typ));
- -- If we ignore the pack for VM_Targets, then warn about
- -- this, except suppress the warning in GNAT mode.
+ -- If we ignore the pack for VM_Targets, then warn about
+ -- this, except suppress the warning in GNAT mode.
- elsif not GNAT_Mode then
- Error_Pragma
- ("?pragma% ignored in this configuration");
- end if;
+ elsif not GNAT_Mode then
+ Error_Pragma
+ ("?pragma% ignored in this configuration");
end if;
end if;
Analyze (N);
end Add_Global_Declaration;
+ -----------------
+ -- Addressable --
+ -----------------
+
+ -- For now, just 8/16/32/64. but analyze later if AAMP is special???
+
+ function Addressable (V : Uint) return Boolean is
+ begin
+ return V = Uint_8 or else
+ V = Uint_16 or else
+ V = Uint_32 or else
+ V = Uint_64;
+ end Addressable;
+
+ function Addressable (V : Int) return Boolean is
+ begin
+ return V = 8 or else
+ V = 16 or else
+ V = 32 or else
+ V = 64;
+ end Addressable;
+
-----------------------
-- Alignment_In_Bits --
-----------------------
-- for the current unit. The declarations are added in the current scope,
-- so the caller should push a new scope as required before the call.
+ function Addressable (V : Uint) return Boolean;
+ function Addressable (V : Int) return Boolean;
+ pragma Inline (Addressable);
+ -- Returns True if the value of V is the word size of an addressable
+ -- factor of the word size (typically 8, 16, 32 or 64).
+
function Alignment_In_Bits (E : Entity_Id) return Uint;
-- If the alignment of the type or object E is currently known to the
-- compiler, then this function returns the alignment value in bits.
projects / platform / upstream / linaro-gcc.git / commitdiff