[multiple changes]
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. From-SVN: r165159
This commit is contained in:
Arnaud Charlet
parent
0ac2a66075
commit
094cefda51
|
|
@ -1,3 +1,30 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -32,6 +32,7 @@
|
|||
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);
|
||||
|
|
@ -98,6 +99,12 @@ package body Ada.Real_Time.Timing_Events is
|
|||
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
|
||||
|
|
|
|||
|
|
@ -3773,6 +3773,13 @@ package body Exp_Aggr is
|
|||
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))
|
||||
|
|
@ -5491,6 +5498,14 @@ package body Exp_Aggr is
|
|||
|
||||
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
|
||||
|
|
@ -5576,13 +5591,32 @@ package body Exp_Aggr is
|
|||
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
|
||||
|
|
|
|||
|
|
@ -3097,7 +3097,9 @@ package body Freeze is
|
|||
|
||||
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
|
||||
|
|
@ -3150,8 +3152,8 @@ package body Freeze is
|
|||
|
||||
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);
|
||||
|
||||
|
|
@ -3213,6 +3215,7 @@ package body Freeze is
|
|||
|
||||
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
|
||||
|
|
@ -3221,6 +3224,8 @@ package body Freeze is
|
|||
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
|
||||
|
|
@ -3277,19 +3282,129 @@ package body Freeze is
|
|||
-- 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
|
||||
|
|
@ -4749,11 +4864,7 @@ package body Freeze is
|
|||
-- 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;
|
||||
|
|
|
|||
|
|
@ -2568,14 +2568,9 @@ package body Layout is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1795,6 +1795,19 @@ package body Sem_Aggr is
|
|||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -1298,34 +1298,6 @@ package body Sem_Ch13 is
|
|||
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
|
||||
|
|
@ -1340,41 +1312,12 @@ package body Sem_Ch13 is
|
|||
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
|
||||
|
|
@ -1435,10 +1378,7 @@ package body Sem_Ch13 is
|
|||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -5928,7 +5928,6 @@ package body Sem_Prag is
|
|||
E : Entity_Id;
|
||||
D : Node_Id;
|
||||
K : Node_Kind;
|
||||
Ctyp : Entity_Id;
|
||||
|
||||
begin
|
||||
Check_Ada_83_Warning;
|
||||
|
|
@ -5970,24 +5969,6 @@ package body Sem_Prag is
|
|||
|
||||
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
|
||||
|
|
@ -8091,9 +8072,9 @@ package body Sem_Prag is
|
|||
Record_Rep_Item (Proc_Id, N);
|
||||
end Implemented;
|
||||
|
||||
-----------------------
|
||||
----------------------
|
||||
-- Implicit_Packing --
|
||||
-----------------------
|
||||
----------------------
|
||||
|
||||
-- pragma Implicit_Packing;
|
||||
|
||||
|
|
@ -9991,76 +9972,40 @@ package body Sem_Prag is
|
|||
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.
|
||||
-- Process OK pragma Pack. Note that if there is a separate
|
||||
-- component clause present, the Pack will be cancelled. This
|
||||
-- processing is in Freeze.
|
||||
|
||||
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
|
||||
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.
|
||||
|
||||
if CodePeer_Mode then
|
||||
null;
|
||||
else
|
||||
Error_Pragma
|
||||
("?pragma% ignored, explicit component size given");
|
||||
end if;
|
||||
|
||||
-- If no prior array component size given, Pack is effective
|
||||
-- For normal non-VM target, do the packing
|
||||
|
||||
else
|
||||
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.
|
||||
|
||||
if CodePeer_Mode then
|
||||
null;
|
||||
|
||||
-- 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;
|
||||
|
||||
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.
|
||||
|
||||
elsif not GNAT_Mode then
|
||||
Error_Pragma
|
||||
("?pragma% ignored in this configuration");
|
||||
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));
|
||||
|
||||
-- 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;
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -245,6 +245,28 @@ package body Sem_Util is
|
|||
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 --
|
||||
-----------------------
|
||||
|
|
|
|||
|
|
@ -51,6 +51,12 @@ package Sem_Util is
|
|||
-- 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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue