-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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 Atree; use Atree;
+with Checks; use Checks;
+with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Namet; use Namet;
with Nmake; use Nmake;
with Opt; use Opt;
+with Output; use Output;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
+with Sinput; use Sinput;
with Snames; use Snames;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
end if;
-- If constant value is an occurrence of an enumeration literal,
- -- then we just make another occurence of the same literal.
+ -- then we just make another occurrence of the same literal.
if Is_Entity_Name (Val)
and then Ekind (Entity (Val)) = E_Enumeration_Literal
Unchecked_Convert_To (T,
New_Occurrence_Of (Entity (Val), Loc)));
- -- Otherwise get the value, and convert to appropriate type
+ -- If constant is of an integer type, just make an appropriately
+ -- integer literal, which will get the proper type.
+
+ elsif Is_Integer_Type (T) then
+ Rewrite (N,
+ Make_Integer_Literal (Loc,
+ Intval => Expr_Rep_Value (Val)));
+
+ -- Otherwise do unchecked conversion of value to right type
else
Rewrite (N,
Unchecked_Convert_To (T,
- Make_Integer_Literal (Loc,
- Intval => Expr_Rep_Value (Val))));
+ Make_Integer_Literal (Loc,
+ Intval => Expr_Rep_Value (Val))));
end if;
Analyze_And_Resolve (N, T);
end loop;
-- If the discriminant occurs within the default expression for a
- -- formal of an entry or protected operation, create a default
- -- function for it, and replace the discriminant with a reference to
- -- the discriminant of the formal of the default function. The
- -- discriminant entity is the one defined in the corresponding
- -- record.
+ -- formal of an entry or protected operation, replace it with a
+ -- reference to the discriminant of the formal of the enclosing
+ -- operation.
if Present (Parent_P)
and then Present (Corresponding_Spec (Parent_P))
Disc : Entity_Id;
begin
- -- Verify that we are within a default function: the type of
- -- its formal parameter is the same task or protected type.
+ -- Verify that we are within the body of an entry or protected
+ -- operation. Its first formal parameter is the synchronized
+ -- type itself.
if Present (Formal)
and then Etype (Formal) = Scope (Entity (N))
and then In_Entry
then
Set_Entity (N, CR_Discriminant (Entity (N)));
+
+ -- Finally, if the entity is the discriminant of the original
+ -- type declaration, and we are within the initialization
+ -- procedure for a task, the designated entity is the
+ -- discriminal of the task body. This can happen when the
+ -- argument of pragma Task_Name mentions a discriminant,
+ -- because the pragma is analyzed in the task declaration
+ -- but is expanded in the call to Create_Task in the init_proc.
+
+ elsif Within_Init_Proc then
+ Set_Entity (N, Discriminal (CR_Discriminant (Entity (N))));
else
Set_Entity (N, Discriminal (Entity (N)));
end if;
elsif Is_Protected_Component (E) then
if No_Run_Time_Mode then
return;
+ else
+ Expand_Protected_Component (N);
end if;
- Expand_Protected_Component (N);
-
elsif Ekind (E) = E_Entry_Index_Parameter then
Expand_Entry_Index_Parameter (N);
Expand_Shared_Passive_Variable (N);
end if;
+ -- Test code for implementing the pragma Reviewable requirement of
+ -- classifying reads of scalars as referencing potentially uninitialized
+ -- objects or not.
+
+ if Debug_Flag_XX
+ and then Is_Scalar_Type (Etype (N))
+ and then (Is_Assignable (E) or else Is_Constant_Object (E))
+ and then Comes_From_Source (N)
+ and then not Is_LHS (N)
+ and then not Is_Actual_Out_Parameter (N)
+ and then (Nkind (Parent (N)) /= N_Attribute_Reference
+ or else Attribute_Name (Parent (N)) /= Name_Valid)
+ then
+ Write_Location (Sloc (N));
+ Write_Str (": Read from scalar """);
+ Write_Name (Chars (N));
+ Write_Str ("""");
+
+ if Is_Known_Valid (E) then
+ Write_Str (", Is_Known_Valid");
+ end if;
+
+ Write_Eol;
+ end if;
+
+ -- Set Atomic_Sync_Required if necessary for atomic variable
+
+ if Nkind_In (N, N_Identifier, N_Expanded_Name)
+ and then Ekind (E) = E_Variable
+ and then (Is_Atomic (E) or else Is_Atomic (Etype (E)))
+ then
+ declare
+ Set : Boolean;
+
+ begin
+ -- If variable is atomic, but type is not, setting depends on
+ -- disable/enable state for the variable.
+
+ if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
+ Set := not Atomic_Synchronization_Disabled (E);
+
+ -- If variable is not atomic, but its type is atomic, setting
+ -- depends on disable/enable state for the type.
+
+ elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then
+ Set := not Atomic_Synchronization_Disabled (Etype (E));
+
+ -- Else both variable and type are atomic (see outer if), and we
+ -- disable if either variable or its type have sync disabled.
+
+ else
+ Set := (not Atomic_Synchronization_Disabled (E))
+ and then
+ (not Atomic_Synchronization_Disabled (Etype (E)));
+ end if;
+
+ -- Set flag if required
+
+ if Set then
+ Activate_Atomic_Synchronization (N);
+ end if;
+ end;
+ end if;
+
-- Interpret possible Current_Value for variable case
- if (Ekind (E) = E_Variable
- or else
- Ekind (E) = E_In_Out_Parameter
- or else
- Ekind (E) = E_Out_Parameter)
+ if Is_Assignable (E)
and then Present (Current_Value (E))
then
Expand_Current_Value (N);
-- we also generate an extra parameter to hold the Constrained
-- attribute of the actual. No renaming is generated for this flag.
- -- Calling Node_Posssible_Modifications in the expander is dubious,
+ -- Calling Note_Possible_Modification in the expander is dubious,
-- because this generates a cross-reference entry, and should be
-- done during semantic processing so it is called in -gnatc mode???
then
Note_Possible_Modification (N, Sure => True);
end if;
-
- Rewrite (N, New_Occurrence_Of (Renamed_Object (Entity (N)), Loc));
- return;
end if;
-- What we need is a reference to the corresponding component of the
-- to turn this into a pointer to the parameter record and then we
-- select the required parameter field.
+ -- The same processing applies to protected entries, where the Accept_
+ -- Address is also the address of the Parameters record.
+
P_Comp_Ref :=
Make_Selected_Component (Loc,
Prefix =>
-- For all types of parameters, the constructed parameter record object
-- contains a pointer to the parameter. Thus we must dereference them to
- -- access them (this will often be redundant, since the needed deference
- -- is implicit, but no harm is done by making it explicit).
+ -- access them (this will often be redundant, since the dereference is
+ -- implicit, but no harm is done by making it explicit).
Rewrite (N,
Make_Explicit_Dereference (Loc, P_Comp_Ref));
OSDN Git Service
