+2011-10-24 Sergey Rybin <rybin@adacore.com frybin>
+
+ * gnat_ugn.texi: For gnatelim, move the note about using the GNAT
+ driver for getting the project support into gnatelim section.
+
+2011-10-24 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Minor correction to documentation on address
+ clause.
+
+2011-10-24 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * s-finmas.adb (Attach): Synchronize and call the unprotected version.
+ (Attach_Unprotected): New routine.
+ (Delete_Finalize_Address): Removed.
+ (Delete_Finalize_Address_Unprotected): New routine.
+ (Detach): Synchronize and call the unprotected version.
+ (Detach_Unprotected): Remove locking.
+ (Finalize): Add various comment on synchronization. Lock the critical
+ region and call the unprotected versions of routines.
+ (Finalize_Address): Removed.
+ (Finalize_Address_Unprotected): New routine.
+ (Set_Finalize_Address): Synchronize and call
+ the unprotected version.
+ (Set_Finalize_Address_Unprotected): New routine.
+ (Set_Heterogeneous_Finalize_Address): Removed.
+ (Set_Heterogeneous_Finalize_Address_Unprotected): New routine.
+ (Set_Is_Heterogeneous): Add comment on synchronization and
+ locking.
+ * s-finmas.ads: Flag Finalization_Started is no longer atomic
+ because synchronization uses task locking / unlocking.
+ (Attach): Add comment on usage.
+ (Attach_Unprotected): New routine.
+ (Delete_Finalize_Address): Renamed to
+ Delete_Finalize_Address_Unprotected.
+ (Detach): Add comment on usage.
+ (Detach_Unprotected): New routine.
+ (Finalize_Address): Renamed to Finalize_Address_Unprotected.
+ (Set_Finalize_Address): Add comment on usage.
+ (Set_Finalize_Address_Unprotected): New routine.
+ (Set_Heterogeneous_Finalize_Address): Renamed to
+ Set_Heterogeneous_Finalize_Address_Unprotected.
+ * s-stposu.adb (Allocate_Any_Controlled): Add local variable
+ Allocation_Locked. Add various comments on synchronization. Lock
+ the critical region and call the unprotected version of
+ routines.
+ (Deallocate_Any_Controlled): Add various comments on
+ synchronization. Lock the critical region and call the unprotected
+ version of routines.
+
+2011-10-24 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Set_Fixed_Range): The bounds of a fixed point type
+ are universal and must carry the corresponding type.
+ * sem_eval.adb (Check_Non_Static_Context): If the type of the
+ expression is universal real, as may be the case for a fixed point
+ expression with constant operands in the context of a conversion,
+ there is nothing to check.
+ * s-finmas.adb: Minor reformatting
+
2011-10-23 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (create_concat_name): Add explicit cast.
@item
There is explicit or implicit initialization required for the object.
-Note that access values are always implicitly initialized, and also
-in GNAT, certain bit-packed arrays (those having a dynamic length or
-a length greater than 64) will also be implicitly initialized to zero.
+Note that access values are always implicitly initialized.
@item
The address value is non-static. Here GNAT is more permissive than the
It then documents the @command{gnatelim} tool and unused subprogram/data
elimination feature, which can reduce the size of program executables.
-Note: to invoke @command{gnatelim} with a project file, use the @code{gnat}
-driver (see @ref{The GNAT Driver and Project Files}).
-
@ifnottex
@menu
* Performance Considerations::
partition and that some subprogram bodies are missing are not generated.
@end table
+@noindent
+Note: to invoke @command{gnatelim} with a project file, use the @code{gnat}
+driver (see @ref{The GNAT Driver and Project Files}).
+
@node Processing Precompiled Libraries
@subsection Processing Precompiled Libraries
see the description of the @command{gnatpp}
switches below. Another possibility is to use a project file and to
call @command{gnatpp} through the @command{gnat} driver
+(see @ref{The GNAT Driver and Project Files}).
The @command{gnatpp} command has the form
provide the configuration file describing the corresponding naming scheme (see
the description of the @command{gnatmetric} switches below.)
Alternatively, you may use a project file and invoke @command{gnatmetric}
-through the @command{gnat} driver.
+through the @command{gnat} driver (see @ref{The GNAT Driver and Project Files}).
The @command{gnatmetric} command has the form
procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr) is
begin
Lock_Task.all;
-
- L.Next.Prev := N;
- N.Next := L.Next;
- L.Next := N;
- N.Prev := L;
-
+ Attach_Unprotected (N, L);
Unlock_Task.all;
-- Note: No need to unlock in case of an exception because the above
-- code can never raise one.
end Attach;
+ ------------------------
+ -- Attach_Unprotected --
+ ------------------------
+
+ procedure Attach_Unprotected
+ (N : not null FM_Node_Ptr;
+ L : not null FM_Node_Ptr)
+ is
+ begin
+ L.Next.Prev := N;
+ N.Next := L.Next;
+ L.Next := N;
+ N.Prev := L;
+ end Attach_Unprotected;
+
---------------
-- Base_Pool --
---------------
return Master.Base_Pool;
end Base_Pool;
- -----------------------------
- -- Delete_Finalize_Address --
- -----------------------------
+ -----------------------------------------
+ -- Delete_Finalize_Address_Unprotected --
+ -----------------------------------------
- procedure Delete_Finalize_Address (Obj : System.Address) is
+ procedure Delete_Finalize_Address_Unprotected (Obj : System.Address) is
begin
- Lock_Task.all;
Finalize_Address_Table.Remove (Obj);
- Unlock_Task.all;
- end Delete_Finalize_Address;
+ end Delete_Finalize_Address_Unprotected;
------------
-- Detach --
procedure Detach (N : not null FM_Node_Ptr) is
begin
- if N.Prev /= null and then N.Next /= null then
- Lock_Task.all;
+ Lock_Task.all;
+ Detach_Unprotected (N);
+ Unlock_Task.all;
+
+ -- Note: No need to unlock in case of an exception because the above
+ -- code can never raise one.
+ end Detach;
+ ------------------------
+ -- Detach_Unprotected --
+ ------------------------
+
+ procedure Detach_Unprotected (N : not null FM_Node_Ptr) is
+ begin
+ if N.Prev /= null and then N.Next /= null then
N.Prev.Next := N.Next;
N.Next.Prev := N.Prev;
N.Prev := null;
N.Next := null;
-
- Unlock_Task.all;
-
- -- Note: No need to unlock in case of an exception because the above
- -- code can never raise one.
end if;
- end Detach;
+ end Detach_Unprotected;
--------------
-- Finalize --
-- Start of processing for Finalize
begin
- -- It is possible for multiple tasks to cause the finalization of the
- -- same master. Let only one task finalize the objects.
+ Lock_Task.all;
+
+ -- Synchronization:
+ -- Read - allocation, finalization
+ -- Write - finalization
if Master.Finalization_Started then
+ Unlock_Task.all;
return;
end if;
-- is explicitly deallocated or the associated access type is about to
-- go out of scope.
+ -- Synchronization:
+ -- Read - allocation, finalization
+ -- Write - finalization
+
Master.Finalization_Started := True;
while not Is_Empty_List (Master.Objects'Unchecked_Access) loop
Curr_Ptr := Master.Objects.Next;
- Detach (Curr_Ptr);
+ -- Synchronization:
+ -- Write - allocation, deallocation, finalization
+
+ Detach_Unprotected (Curr_Ptr);
-- Skip the list header in order to offer proper object layout for
-- finalization.
-- Retrieve TSS primitive Finalize_Address depending on the master's
-- mode of operation.
+ -- Synchronization:
+ -- Read - allocation, finalization
+ -- Write - outside
+
if Master.Is_Homogeneous then
+
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, outside
+
Cleanup := Master.Finalize_Address;
- else
- Cleanup := Finalize_Address (Obj_Addr);
- end if;
- -- If Finalize_Address is not available, then this is most likely an
- -- error in the expansion of the designated type or the allocator.
+ else
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, deallocation
- pragma Assert (Cleanup /= null);
+ Cleanup := Finalize_Address_Unprotected (Obj_Addr);
+ end if;
begin
Cleanup (Obj_Addr);
-
exception
when Fin_Occur : others =>
if not Raised then
-- When the master is a heterogeneous collection, destroy the object
-- - Finalize_Address pair since it is no longer needed.
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - outside
+
if not Master.Is_Homogeneous then
- Delete_Finalize_Address (Obj_Addr);
+
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, deallocation, finalization
+
+ Delete_Finalize_Address_Unprotected (Obj_Addr);
end if;
end loop;
+ Unlock_Task.all;
+
-- If the finalization of a particular object failed or Finalize_Address
-- was not set, reraise the exception now.
return Master.Finalize_Address;
end Finalize_Address;
- ----------------------
- -- Finalize_Address --
- ----------------------
+ ----------------------------------
+ -- Finalize_Address_Unprotected --
+ ----------------------------------
- function Finalize_Address
+ function Finalize_Address_Unprotected
(Obj : System.Address) return Finalize_Address_Ptr
is
- Result : Finalize_Address_Ptr;
begin
- Lock_Task.all;
- Result := Finalize_Address_Table.Get (Obj);
- Unlock_Task.all;
- return Result;
- end Finalize_Address;
+ return Finalize_Address_Table.Get (Obj);
+ end Finalize_Address_Unprotected;
--------------------------
-- Finalization_Started --
Fin_Addr_Ptr : Finalize_Address_Ptr)
is
begin
- -- TSS primitive Finalize_Address is set at the point of allocation,
- -- either through Allocate_Any_Controlled or through this routine.
- -- Since multiple tasks can allocate on the same finalization master,
- -- access to this attribute must be protected.
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, outside
Lock_Task.all;
+ Set_Finalize_Address_Unprotected (Master, Fin_Addr_Ptr);
+ Unlock_Task.all;
+ end Set_Finalize_Address;
+ --------------------------------------
+ -- Set_Finalize_Address_Unprotected --
+ --------------------------------------
+
+ procedure Set_Finalize_Address_Unprotected
+ (Master : in out Finalization_Master;
+ Fin_Addr_Ptr : Finalize_Address_Ptr)
+ is
+ begin
if Master.Finalize_Address = null then
Master.Finalize_Address := Fin_Addr_Ptr;
end if;
+ end Set_Finalize_Address_Unprotected;
- Unlock_Task.all;
- end Set_Finalize_Address;
-
- ----------------------------------------
- -- Set_Heterogeneous_Finalize_Address --
- ----------------------------------------
+ ----------------------------------------------------
+ -- Set_Heterogeneous_Finalize_Address_Unprotected --
+ ----------------------------------------------------
- procedure Set_Heterogeneous_Finalize_Address
+ procedure Set_Heterogeneous_Finalize_Address_Unprotected
(Obj : System.Address;
Fin_Addr_Ptr : Finalize_Address_Ptr)
is
begin
- -- Protected access is required in this case because
- -- Finalize_Address_Table is a global data structure.
-
- Lock_Task.all;
Finalize_Address_Table.Set (Obj, Fin_Addr_Ptr);
- Unlock_Task.all;
- end Set_Heterogeneous_Finalize_Address;
+ end Set_Heterogeneous_Finalize_Address_Unprotected;
--------------------------
-- Set_Is_Heterogeneous --
procedure Set_Is_Heterogeneous (Master : in out Finalization_Master) is
begin
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - outside
+
+ Lock_Task.all;
Master.Is_Homogeneous := False;
+ Unlock_Task.all;
end Set_Is_Heterogeneous;
end System.Finalization_Masters;
for Finalization_Master_Ptr'Storage_Size use 0;
procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
+ -- Compiler interface, do not call from withing the run-time. Prepend a
+ -- node to a specific finalization master.
+
+ procedure Attach_Unprotected
+ (N : not null FM_Node_Ptr;
+ L : not null FM_Node_Ptr);
-- Prepend a node to a specific finalization master
- procedure Delete_Finalize_Address (Obj : System.Address);
+ procedure Delete_Finalize_Address_Unprotected (Obj : System.Address);
-- Destroy the relation pair object - Finalize_Address from the internal
-- hash table.
procedure Detach (N : not null FM_Node_Ptr);
+ -- Compiler interface, do not call from within the run-time. Remove a node
+ -- from an arbitrary finalization master.
+
+ procedure Detach_Unprotected (N : not null FM_Node_Ptr);
-- Remove a node from an arbitrary finalization master
overriding procedure Finalize (Master : in out Finalization_Master);
-- Return a reference to the TSS primitive Finalize_Address associated with
-- a master.
- function Finalize_Address
+ function Finalize_Address_Unprotected
(Obj : System.Address) return Finalize_Address_Ptr;
-- Retrieve the Finalize_Address primitive associated with a particular
-- object.
procedure Set_Finalize_Address
(Master : in out Finalization_Master;
Fin_Addr_Ptr : Finalize_Address_Ptr);
+ -- Compiler interface, do not call from within the run-time. Set the clean
+ -- up routine of a finalization master
+
+ procedure Set_Finalize_Address_Unprotected
+ (Master : in out Finalization_Master;
+ Fin_Addr_Ptr : Finalize_Address_Ptr);
-- Set the clean up routine of a finalization master
- procedure Set_Heterogeneous_Finalize_Address
+ procedure Set_Heterogeneous_Finalize_Address_Unprotected
(Obj : System.Address;
Fin_Addr_Ptr : Finalize_Address_Ptr);
-- Add a relation pair object - Finalize_Address to the internal hash
-- is used only when the master is in homogeneous mode.
Finalization_Started : Boolean := False;
- pragma Atomic (Finalization_Started);
-- A flag used to detect allocations which occur during the finalization
-- of a master. The allocations must raise Program_Error. This scenario
- -- may arise in a multitask environment. The flag is atomic because it
- -- is accessed without Lock_Task / Unlock_Task.
+ -- may arise in a multitask environment.
end record;
-- Since RTSfind cannot contain names of the form RE_"+", the following
N_Size : Storage_Count;
Subpool : Subpool_Handle := null;
+ Allocation_Locked : Boolean;
+ -- This flag stores the state of the associated collection
+
Header_And_Padding : Storage_Offset;
-- This offset includes the size of a FM_Node plus any additional
-- padding due to a larger alignment.
-- failed to create one. This is a serious error.
if Context_Master = null then
- raise Program_Error with "missing master in pool allocation";
- end if;
+ raise Program_Error
+ with "missing master in pool allocation";
-- If a subpool is present, then this is the result of erroneous
-- allocator expansion. This is not a serious error, but it should
-- still be detected.
- if Context_Subpool /= null then
- raise Program_Error with "subpool not required in pool allocation";
- end if;
+ elsif Context_Subpool /= null then
+ raise Program_Error
+ with "subpool not required in pool allocation";
-- If the allocation is intended to be on a subpool, but the access
-- type's pool does not support subpools, then this is the result of
-- erroneous end-user code.
- if On_Subpool then
+ elsif On_Subpool then
raise Program_Error
with "pool of access type does not support subpools";
end if;
if Is_Controlled then
+ -- Synchronization:
+ -- Read - allocation, finalization
+ -- Write - finalization
+
+ Lock_Task.all;
+ Allocation_Locked := Finalization_Started (Master.all);
+ Unlock_Task.all;
+
-- Do not allow the allocation of controlled objects while the
-- associated master is being finalized.
- if Finalization_Started (Master.all) then
+ if Allocation_Locked then
raise Program_Error with "allocation after finalization started";
end if;
-- Step 4: Attachment
if Is_Controlled then
+ Lock_Task.all;
-- Map the allocated memory into a FM_Node record. This converts the
-- top of the allocated bits into a list header. If there is padding
-- Prepend the allocated object to the finalization master
- Attach (N_Ptr, Objects (Master.all));
+ -- Synchronization:
+ -- Write - allocation, deallocation, finalization
+
+ Attach_Unprotected (N_Ptr, Objects (Master.all));
-- Move the address from the hidden list header to the start of the
-- object. This operation effectively hides the list header.
-- 2) Named access types
-- 3) Most cases of anonymous access types usage
+ -- Synchronization:
+ -- Read - allocation, finalization
+ -- Write - outside
+
if Master.Is_Homogeneous then
- Set_Finalize_Address (Master.all, Fin_Address);
+
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, outside
+
+ Set_Finalize_Address_Unprotected (Master.all, Fin_Address);
-- Heterogeneous masters service the following:
-- 2) Certain cases of anonymous access types usage
else
- Set_Heterogeneous_Finalize_Address (Addr, Fin_Address);
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, deallocation
+
+ Set_Heterogeneous_Finalize_Address_Unprotected (Addr, Fin_Address);
Finalize_Address_Table_In_Use := True;
end if;
+ Unlock_Task.all;
+
-- Non-controlled allocation
else
-- Step 1: Detachment
if Is_Controlled then
+ Lock_Task.all;
-- Destroy the relation pair object - Finalize_Address since it is no
-- longer needed.
if Finalize_Address_Table_In_Use then
- Delete_Finalize_Address (Addr);
+
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, deallocation
+
+ Delete_Finalize_Address_Unprotected (Addr);
end if;
-- Account for possible padding space before the header due to a
-- action does not need to know the prior context used during
-- allocation.
- Detach (N_Ptr);
+ -- Synchronization:
+ -- Write - allocation, deallocation, finalization
+
+ Detach_Unprotected (N_Ptr);
-- Move the address from the object to the beginning of the list
-- header.
N_Size := Storage_Size + Header_And_Padding;
+ Unlock_Task.all;
+
else
N_Addr := Addr;
N_Size := Storage_Size;
-- do not know the exact end points at the time of the declaration. This
-- is true for three reasons:
- -- A size clause may affect the fudging of the end-points
- -- A small clause may affect the values of the end-points
- -- We try to include the end-points if it does not affect the size
+ -- A size clause may affect the fudging of the end-points.
+ -- A small clause may affect the values of the end-points.
+ -- We try to include the end-points if it does not affect the size.
- -- This means that the actual end-points must be established at the point
- -- when the type is frozen. Meanwhile, we first narrow the range as
- -- permitted (so that it will fit if necessary in a small specified size),
- -- and then build a range subtree with these narrowed bounds.
-
- -- Set_Fixed_Range constructs the range from real literal values, and sets
- -- the range as the Scalar_Range of the given fixed-point type entity.
+ -- This means that the actual end-points must be established at the
+ -- point when the type is frozen. Meanwhile, we first narrow the range
+ -- as permitted (so that it will fit if necessary in a small specified
+ -- size), and then build a range subtree with these narrowed bounds.
+ -- Set_Fixed_Range constructs the range from real literal values, and
+ -- sets the range as the Scalar_Range of the given fixed-point type entity.
-- The parent of this range is set to point to the entity so that it is
-- properly hooked into the tree (unlike normal Scalar_Range entries for
begin
Set_Scalar_Range (E, S);
Set_Parent (S, E);
+
+ -- Before the freeze point, the bounds of a fixed point are universal
+ -- and carry the corresponding type.
+
+ Set_Etype (Low_Bound (S), Universal_Real);
+ Set_Etype (High_Bound (S), Universal_Real);
end Set_Fixed_Range;
----------------------------------
and not Range_Checks_Suppressed (T);
begin
- -- Ignore cases of non-scalar types or error types
+ -- Ignore cases of non-scalar types, error types, or universal real
+ -- types that have no usable bounds.
- if T = Any_Type or else not Is_Scalar_Type (T) then
+ if T = Any_Type
+ or else not Is_Scalar_Type (T)
+ or else T = Universal_Fixed
+ or else T = Universal_Real
+ then
return;
end if;
- -- At this stage we have a scalar type. If we have an expression
- -- that raises CE, then we already issued a warning or error msg
- -- so there is nothing more to be done in this routine.
+ -- At this stage we have a scalar type. If we have an expression that
+ -- raises CE, then we already issued a warning or error msg so there
+ -- is nothing more to be done in this routine.
if Raises_Constraint_Error (N) then
return;
end if;
- -- Now we have a scalar type which is not marked as raising a
- -- constraint error exception. The main purpose of this routine
- -- is to deal with static expressions appearing in a non-static
- -- context. That means that if we do not have a static expression
- -- then there is not much to do. The one case that we deal with
- -- here is that if we have a floating-point value that is out of
- -- range, then we post a warning that an infinity will result.
+ -- Now we have a scalar type which is not marked as raising a constraint
+ -- error exception. The main purpose of this routine is to deal with
+ -- static expressions appearing in a non-static context. That means
+ -- that if we do not have a static expression then there is not much
+ -- to do. The one case that we deal with here is that if we have a
+ -- floating-point value that is out of range, then we post a warning
+ -- that an infinity will result.
if not Is_Static_Expression (N) then
if Is_Floating_Point_Type (T)
return;
end if;
- -- Here we have the case of outer level static expression of
- -- scalar type, where the processing of this procedure is needed.
+ -- Here we have the case of outer level static expression of scalar
+ -- type, where the processing of this procedure is needed.
-- For real types, this is where we convert the value to a machine
- -- number (see RM 4.9(38)). Also see ACVC test C490001. We should
- -- only need to do this if the parent is a constant declaration,
- -- since in other cases, gigi should do the necessary conversion
- -- correctly, but experimentation shows that this is not the case
- -- on all machines, in particular if we do not convert all literals
- -- to machine values in non-static contexts, then ACVC test C490001
- -- fails on Sparc/Solaris and SGI/Irix.
+ -- number (see RM 4.9(38)). Also see ACVC test C490001. We should only
+ -- need to do this if the parent is a constant declaration, since in
+ -- other cases, gigi should do the necessary conversion correctly, but
+ -- experimentation shows that this is not the case on all machines, in
+ -- particular if we do not convert all literals to machine values in
+ -- non-static contexts, then ACVC test C490001 fails on Sparc/Solaris
+ -- and SGI/Irix.
if Nkind (N) = N_Real_Literal
and then not Is_Machine_Number (N)
elsif not UR_Is_Zero (Realval (N)) then
- -- Note: even though RM 4.9(38) specifies biased rounding,
- -- this has been modified by AI-100 in order to prevent
- -- confusing differences in rounding between static and
- -- non-static expressions. AI-100 specifies that the effect
- -- of such rounding is implementation dependent, and in GNAT
- -- we round to nearest even to match the run-time behavior.
+ -- Note: even though RM 4.9(38) specifies biased rounding, this
+ -- has been modified by AI-100 in order to prevent confusing
+ -- differences in rounding between static and non-static
+ -- expressions. AI-100 specifies that the effect of such rounding
+ -- is implementation dependent, and in GNAT we round to nearest
+ -- even to match the run-time behavior.
Set_Realval
(N, Machine (Base_Type (T), Realval (N), Round_Even, N));
-- simple cases can be recognized.
function Is_Same_Value (L, R : Node_Id) return Boolean;
- -- Returns True iff L and R represent expressions that definitely
- -- have identical (but not necessarily compile time known) values
- -- Indeed the caller is expected to have already dealt with the
- -- cases of compile time known values, so these are not tested here.
+ -- Returns True iff L and R represent expressions that definitely have
+ -- identical (but not necessarily compile time known) values Indeed the
+ -- caller is expected to have already dealt with the cases of compile
+ -- time known values, so these are not tested here.
-----------------------
-- Compare_Decompose --
projects / thirdparty / gcc.git / commitdiff
