Skip to content

R
riscv-gcc-1
Commit 70f91180 by Robert Dewar Committed by Arnaud Charlet
Options

s-rident.ads: Add No_Default_Initialization restriction 

2008-04-08  Robert Dewar  <dewar@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* s-rident.ads: Add No_Default_Initialization restriction

	* exp_tss.adb: 
	(Has_Non_Null_Base_Init_Proc): Handle No_Default_Initialization case
	(Set_TSS): Handle No_Default_Initialization case

	* exp_ch6.adb (Expand_N_Subprogram_Body): Handle restriction
	No_Default_Initialization
	(Expand_N_Subprogram_Body): Remove redundant initialization of out
	parameters when Normalize_Scalars is active.
	(Add_Final_List_Actual_To_Build_In_Place_Call): Add formal Sel_Comp
	Fix casing error in formal parameter name in call
	(Register_Predefined_DT_Entry): Replace occurrences of RE_Address by
	(Expand_Call, Propagate_Tag): Call Kill_Current_Values when processing a
	dispatching call on VM targets.

From-SVN: r134028
parent 45fc7ddb
Showing with 68 additions and 45 deletions
gcc/ada/exp_tss.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -28,6 +28,8 @@ with Einfo; use Einfo;
with Elists; use Elists;
with Exp_Util; use Exp_Util;
with Lib; use Lib;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
......@@ -159,11 +161,16 @@ package body Exp_Tss is
-- Has_Non_Null_Base_Init_Proc --
---------------------------------
-- Note: if a base Init_Proc is present, and No_Default_Initialization is
-- present, then we must avoid testing for a null init proc, since there
-- is no init proc present in this case.
function Has_Non_Null_Base_Init_Proc (Typ : Entity_Id) return Boolean is
BIP : constant Entity_Id := Base_Init_Proc (Typ);
begin
return Present (BIP) and then not Is_Null_Init_Proc (BIP);
return Present (BIP)
and then (Restriction_Active (No_Default_Initialization)
or else not Is_Null_Init_Proc (BIP));
end Has_Non_Null_Base_Init_Proc;
---------------
......@@ -306,20 +313,31 @@ package body Exp_Tss is
-------------
procedure Set_TSS (Typ : Entity_Id; TSS : Entity_Id) is
Subprog_Body : constant Node_Id := Unit_Declaration_Node (TSS);
begin
-- Case of insertion location is in unit defining the type
-- Make sure body of subprogram is frozen
if In_Same_Code_Unit (Typ, TSS) then
Append_Freeze_Action (Typ, Subprog_Body);
-- Skip this for Init_Proc with No_Default_Initialization, since the
-- Init proc is a dummy void entity in this case to be ignored.
-- Otherwise, we are using an already existing TSS in another unit
if Is_Init_Proc (TSS)
and then Restriction_Active (No_Default_Initialization)
then
null;
else
-- Skip this if not in the same code unit (since it means we are using
-- an already existing TSS in another unit)
elsif not In_Same_Code_Unit (Typ, TSS) then
null;
-- Otherwise make sure body is frozen
else
Append_Freeze_Action (Typ, Unit_Declaration_Node (TSS));
end if;
-- Set TSS entry
Copy_TSS (TSS, Typ);
end Set_TSS;
......
gcc/ada/s-rident.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -56,7 +56,9 @@ package System.Rident is
type Restriction_Id is
-- The following cases are checked for consistency in the binder
-- The following cases are checked for consistency in the binder. The
-- binder will check that every unit either has the restriction set, or
-- does not violate the restriction.
(Simple_Barriers, -- GNAT (Ravenscar)
No_Abort_Statements, -- (RM D.7(5), H.4(3))
......@@ -111,7 +113,12 @@ package System.Rident is
Static_Priorities, -- GNAT
Static_Storage_Size, -- GNAT
-- The following cases do not require partition-wide checks
-- The following require consistency checking with special rules. See
-- individual routines in unit Bcheck for details of what is required.
No_Default_Initialization, -- GNAT
-- The following cases do not require consistency checking
Immediate_Reclamation, -- (RM H.4(10))
No_Implementation_Attributes, -- Ada 2005 AI-257
......@@ -123,29 +130,28 @@ package System.Rident is
-- The following cases require a parameter value
-- The following entries are fully checked at compile/bind time,
-- which means that the compiler can in general tell the minimum
-- value which could be used with a restrictions pragma. The binder
-- can deduce the appropriate minimum value for the partition by
-- taking the maximum value required by any unit.
-- The following entries are fully checked at compile/bind time, which
-- means that the compiler can in general tell the minimum value which
-- could be used with a restrictions pragma. The binder can deduce the
-- appropriate minimum value for the partition by taking the maximum
-- value required by any unit.
Max_Protected_Entries, -- (RM D.7(14))
Max_Select_Alternatives, -- (RM D.7(12))
Max_Task_Entries, -- (RM D.7(13), H.4(3))
-- The following entries are also fully checked at compile/bind
-- time, and the compiler can also at least in some cases tell
-- the minimum value which could be used with a restriction pragma.
-- The difference is that the contributions are additive, so the
-- binder deduces this value by adding the unit contributions.
-- The following entries are also fully checked at compile/bind time,
-- and the compiler can also at least in some cases tell the minimum
-- value which could be used with a restriction pragma. The difference
-- is that the contributions are additive, so the binder deduces this
-- value by adding the unit contributions.
Max_Tasks, -- (RM D.7(19), H.4(3))
-- The following entries are checked at compile time only for
-- zero/nonzero entries. This means that the compiler can tell
-- at compile time if a restriction value of zero is (would be)
-- violated, but that is all. The compiler cannot distinguish
-- between different non-zero values.
-- The following entries are checked at compile time only for zero/
-- nonzero entries. This means that the compiler can tell at compile
-- time if a restriction value of zero is (would be) violated, but that
-- the compiler cannot distinguish between different non-zero values.
Max_Asynchronous_Select_Nesting, -- (RM D.7(18), H.4(3))
Max_Entry_Queue_Length, -- GNAT
......@@ -237,9 +243,9 @@ package System.Rident is
-- Restriction Status Declarations --
-------------------------------------
-- The following declarations are used to record the current status
-- or restrictions (for the current unit, or related units, at compile
-- time, and for all units in a partition at bind time or run time).
-- The following declarations are used to record the current status or
-- restrictions (for the current unit, or related units, at compile time,
-- and for all units in a partition at bind time or run time).
type Restriction_Flags is array (All_Restrictions) of Boolean;
type Restriction_Values is array (All_Parameter_Restrictions) of Natural;
......@@ -247,11 +253,10 @@ package System.Rident is
type Restrictions_Info is record
Set : Restriction_Flags;
-- An entry is True in the Set array if a restrictions pragma has
-- been encountered for the given restriction. If the value is
-- True for a parameter restriction, then the corresponding entry
-- in the Value array gives the minimum value encountered for any
-- such restriction.
-- An entry is True in the Set array if a restrictions pragma has been
-- encountered for the given restriction. If the value is True for a
-- parameter restriction, then the corresponding entry in the Value
-- array gives the minimum value encountered for any such restriction.
Value : Restriction_Values;
-- If the entry for a parameter restriction in Set is True (i.e. a
......@@ -261,23 +266,23 @@ package System.Rident is
-- pragma specifying a value greater than Int'Last is simply ignored.
Violated : Restriction_Flags;
-- An entry is True in the violations array if the compiler has
-- detected a violation of the restriction. For a parameter
-- restriction, the Count and Unknown arrays have additional
-- information.
-- An entry is True in the violations array if the compiler has detected
-- a violation of the restriction. For a parameter restriction, the
-- Count and Unknown arrays have additional information.
Count : Restriction_Values;
-- If an entry for a parameter restriction is True in Violated,
-- the corresponding entry in the Count array may record additional
-- If an entry for a parameter restriction is True in Violated, the
-- corresponding entry in the Count array may record additional
-- information. If the actual minimum count is known (by taking
-- maximums, or sums, depending on the restriction), it will be
-- recorded in this array. If not, then the value will remain zero.
-- The value is also zero for a non-violated restriction.
Unknown : Parameter_Flags;
-- If an entry for a parameter restriction is True in Violated,
-- the corresponding entry in the Unknown array may record additional
-- If an entry for a parameter restriction is True in Violated, the
-- corresponding entry in the Unknown array may record additional
-- information. If the actual count is not known by the compiler (but
-- is known to be non-zero), then the entry in Unknown will be True.
-- is nown to be non-zero), then the entry in Unknown will be True.
-- This indicates that the value in Count is not known to be exact,
-- and the actual violation count may be higher.
......
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