+2015-05-12 Robert Dewar <dewar@adacore.com>
+
+ * sem_util.adb (Is_Variable): Allow X'Deref(Y) as a variable.
+
+2015-05-12 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch8.adb (Find_Expanded_Name): Handle properly a fully
+ qualified name for an instance of a generic grand-child unit in
+ the body its parent.
+
+2015-05-12 Robert Dewar <dewar@adacore.com>
+
+ * exp_unst.adb (Upref_Name): New subprogram.
+ (Unnest_Subprogram): Use Upref_Name.
+ (Unnest_Subprogram): Use new Deref attribute.
+ * exp_unst.ads: Doc updates.
+
+2015-05-12 Thomas Quinot <quinot@adacore.com>
+
+ * adaint.c: Enable Large File Support in adaint so that __gnat_readdir
+ can access files on filesystems mounted from servers that use large
+ NFS file handles.
+
2015-05-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (gnat_write_global_declarations): Use type_decl
#define _REENTRANT
#define _THREAD_SAFE
+/* Use 64 bit Large File API */
+#ifndef _LARGEFILE_SOURCE
+#define _LARGEFILE_SOURCE
+#endif
+#define _FILE_OFFSET_BITS 64
+
#ifdef __vxworks
/* No need to redefine exit here. */
with Atree; use Atree;
with Einfo; use Einfo;
with Elists; use Elists;
-with Exp_Util; use Exp_Util;
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
function Subp_Index (Sub : Entity_Id) return SI_Type;
-- Given the entity for a subprogram, return corresponding Subps index
+ function Upref_Name (Ent : Entity_Id) return Name_Id;
+ -- This function returns the name to be used in the activation record to
+ -- reference the variable uplevel. Normally this is just a copy of the
+ -- Chars field of the entity. The exception is when the scope of Ent
+ -- is a declare block, in which case we append the entity number to
+ -- make sure that no confusion occurs between use of the same name
+ -- in different declare blocks.
+
----------------
-- Actual_Ref --
----------------
return SI_Type (UI_To_Int (Subps_Index (Sub)));
end Subp_Index;
+ ----------------
+ -- Upref_Name --
+ ----------------
+
+ function Upref_Name (Ent : Entity_Id) return Name_Id is
+ begin
+ if Ekind (Scope (Ent)) /= E_Block then
+ return Chars (Ent);
+
+ else
+ Get_Name_String (Chars (Ent));
+ Add_Str_To_Name_Buffer ("__");
+ Add_Nat_To_Name_Buffer (Nat (Ent));
+ return Name_Enter;
+ end if;
+ end Upref_Name;
+
-- Start of processing for Unnest_Subprogram
begin
for J in 1 .. Num_Uplevel_Entities loop
Comp :=
Make_Defining_Identifier (Loc,
- Chars => Chars (Uplevel_Entities (J)));
+ Chars => Upref_Name (Uplevel_Entities (J)));
Set_Activation_Record_Component
(Uplevel_Entities (J), Comp);
end if;
-- Build and insert the assignment:
- -- ARECn.nam := nam
+ -- ARECn.nam := nam'Address
Asn :=
Make_Assignment_Statement (Loc,
Prefix =>
New_Occurrence_Of (STJ.ARECn, Loc),
Selector_Name =>
- Make_Identifier (Loc, Chars (Ent))),
+ New_Occurrence_Of
+ (Activation_Record_Component (Ent),
+ Loc)),
Expression =>
Make_Attribute_Reference (Loc,
STJR : Subp_Entry renames Subps.Table (RSX);
-- Subp_Entry for enclosing subprogram for ref
- Tnn : constant Entity_Id :=
- Make_Temporary
- (Loc, 'T', Related_Node => Ref);
- -- Local pointer type for reference
-
Pfx : Node_Id;
Comp : Entity_Id;
SI : SI_Type;
Push_Scope (STJR.Ent);
- -- First insert declaration for pointer type
-
- -- type Tnn is access all typ;
-
- Insert_Action (Node (Elmt),
- Make_Full_Type_Declaration (Loc,
- Defining_Identifier => Tnn,
- Type_Definition =>
- Make_Access_To_Object_Definition (Loc,
- All_Present => True,
- Subtype_Indication =>
- New_Occurrence_Of (Typ, Loc))));
-
-- Now we need to rewrite the reference. We have a
-- reference is from level STJE.Lev to level STJ.Lev.
-- The general form of the rewritten reference for
-- entity X is:
- -- Tnn!(ARECaF.ARECbU.ARECcU.ARECdU....ARECm.X).all
+ -- Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECm.X)
-- where a,b,c,d .. m =
- -- STJR.Lev - 1, STJ.Lev - 2, .. STJ.Lev
+ -- STJR.Lev - 1, STJ.Lev - 2, .. STJ.Lev
pragma Assert (STJR.Lev > STJ.Lev);
-- Do the replacement
Rewrite (Ref,
- Make_Explicit_Dereference (Loc,
- Prefix =>
- Unchecked_Convert_To (Tnn,
- Make_Selected_Component (Loc,
- Prefix => Pfx,
- Selector_Name =>
- New_Occurrence_Of (Comp, Loc)))));
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Attribute_Name => Name_Deref,
+ Expressions => New_List (
+ Make_Selected_Component (Loc,
+ Prefix => Pfx,
+ Selector_Name =>
+ New_Occurrence_Of (Comp, Loc)))));
-- Analyze and resolve the new expression. We do not
-- need to establish the relevant scope stack entries
-- outer level of nesting. As we will see later, deeper levels of nesting
-- will use AREC2, AREC3, ...
+ -- Note: normally the field names in the activation record match the
+ -- name of the entity. An exception is when the entity is declared in
+ -- a declare block, in which case we append the entity number, to avoid
+ -- clashes between the same name declared in different declare blocks.
+
-- For all subprograms nested immediately within the corresponding scope,
-- a parameter AREC1F is passed, and all calls to these routines have
-- AREC1P added as an additional formal.
-- Now within the nested procedures, any reference to an uplevel entity
- -- xxx is replaced by Tnn!(AREC1.xxx).all (where ! represents a call
- -- to unchecked conversion to convert the address to the access type
- -- and Tnn is a locally declared type that is "access all t", where t
- -- is the type of the reference).
+ -- xxx is replaced by typ'Deref(AREC1.xxx) where typ is the type of the
+ -- reference.
-- Note: the reason that we use Address as the component type in the
-- declaration of AREC1T is that we may create this type before we see
--
-- procedure inner (bb : integer; AREC1F : AREC1PT) is
-- begin
- -- type Tnn1 is access all Integer;
- -- type Tnn2 is access all Integer;
- -- type Tnn3 is access all Integer;
- -- Tnn1!(AREC1F.x).all :=
- -- Tnn2!(AREC1F.rv).all + y + b + Tnn3!(AREC1F.b).all;
+ -- Integer'Deref(AREC1F.x) :=
+ -- Integer'Deref(AREC1F.rv) + y + b + Integer_Deref(AREC1F.b);
-- end;
--
-- begin
--
-- function inner (b : integer; AREC1F : AREC1PT) return boolean is
-- begin
- -- type Tnn is access all Integer
- -- return b in x .. Tnn!(AREC1F.dynam_LAST).all
+ -- return b in x .. Integer'Deref(AREC1F.dynam_LAST)
-- and then darecv.b in 42 .. 73;
-- end inner;
--
-- type AREC2PT is access all AREC2T;
-- AREC2P : constant AREC2PT := AREC2'Access;
--
- -- type Tnn1 is access all Integer;
- -- v2 : integer := Tnn1!(AREC1F.v1).all {+} 1;
+ -- v2 : integer := Integer'Deref (AREC1F.v1) {+} 1;
-- AREC2.v2 := v2'Address;
--
-- function inner2
-- (z : integer; AREC2F : AREC2PT) return integer
-- is
-- begin
- -- type Tnn1 is access all Integer;
- -- type Tnn2 is access all Integer;
-- return integer(z {+}
- -- Tnn1!(AREC2F.AREC1U.v1).all {+}
- -- Tnn2!(AREC2F.v2).all);
+ -- Integer'Deref (AREC2F.AREC1U.v1) {+}
+ -- Integer'Deref (AREC2F.v2).all);
-- end inner2;
-- begin
- -- type Tnn is access all Integer;
- -- return integer(y {+} inner2 (Tnn!(AREC1F.v1).all, AREC2P));
+ -- return integer(y {+}
+ -- inner2 (Integer'Deref (AREC1F.v1), AREC2P));
-- end inner1;
-- begin
-- return inner1 (x, AREC1P);
end if;
if Is_New_Candidate then
+
+ -- If entity is a child unit, either it is a visible child of
+ -- the prefix, or we are in the body of a generic prefix, as
+ -- will happen when a child unit is instantiated in the body
+ -- of a generic parent. This is because the instance body does
+ -- not restore the full compilation context, given that all
+ -- non-local references have been captured.
+
if Is_Child_Unit (Id) or else P_Name = Standard_Standard then
- exit when Is_Visible_Lib_Unit (Id);
+ exit when Is_Visible_Lib_Unit (Id)
+ or else (Is_Child_Unit (Id)
+ and then In_Open_Scopes (Scope (Id))
+ and then In_Instance_Body);
else
exit when not Is_Hidden (Id);
end if;
-- Start of processing for Is_Variable
begin
+ -- Special check, allow x'Deref(expr) as a variable
+
+ if Nkind (N) = N_Attribute_Reference
+ and then Attribute_Name (N) = Name_Deref
+ then
+ return True;
+ end if;
+
-- Check if we perform the test on the original node since this may be a
-- test of syntactic categories which must not be disturbed by whatever
-- rewriting might have occurred. For example, an aggregate, which is
and then Has_Foreign_Convention (E)
then
- -- A convention pragma in an instance may apply to the subtype
+ -- A pragma Convention in an instance may apply to the subtype
-- created for a formal, in which case we have already verified
-- that conventions of actual and formal match and there is nothing
-- to flag on the subtype.
projects / gcc.git / commitdiff