[multiple changes]
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. From-SVN: r223035
This commit is contained in:
Arnaud Charlet
parent
3a857fd0d3
commit
ddbc55d8ad
|
|
@ -1,3 +1,26 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -38,6 +38,12 @@
|
|||
#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. */
|
||||
|
|
|
|||
|
|
@ -26,7 +26,6 @@
|
|||
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;
|
||||
|
|
@ -358,6 +357,14 @@ package body Exp_Unst is
|
|||
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 --
|
||||
----------------
|
||||
|
|
@ -445,6 +452,23 @@ package body Exp_Unst is
|
|||
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
|
||||
|
|
@ -913,7 +937,7 @@ package body Exp_Unst is
|
|||
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);
|
||||
|
|
@ -1029,7 +1053,7 @@ package body Exp_Unst is
|
|||
end if;
|
||||
|
||||
-- Build and insert the assignment:
|
||||
-- ARECn.nam := nam
|
||||
-- ARECn.nam := nam'Address
|
||||
|
||||
Asn :=
|
||||
Make_Assignment_Statement (Loc,
|
||||
|
|
@ -1038,7 +1062,9 @@ package body Exp_Unst is
|
|||
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,
|
||||
|
|
@ -1124,11 +1150,6 @@ package body Exp_Unst is
|
|||
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;
|
||||
|
|
@ -1141,28 +1162,15 @@ package body Exp_Unst is
|
|||
|
||||
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);
|
||||
|
||||
|
|
@ -1206,13 +1214,14 @@ package body Exp_Unst is
|
|||
-- 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
|
||||
|
|
|
|||
|
|
@ -187,15 +187,18 @@ package Exp_Unst is
|
|||
-- 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
|
||||
|
|
@ -233,11 +236,8 @@ package Exp_Unst is
|
|||
--
|
||||
-- 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
|
||||
|
|
@ -388,8 +388,7 @@ package Exp_Unst is
|
|||
--
|
||||
-- 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;
|
||||
--
|
||||
|
|
@ -440,23 +439,20 @@ package Exp_Unst is
|
|||
-- 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);
|
||||
|
|
|
|||
|
|
@ -5791,8 +5791,19 @@ package body Sem_Ch8 is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -12771,6 +12771,14 @@ package body Sem_Util is
|
|||
-- 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
|
||||
|
|
@ -16855,7 +16863,7 @@ package body Sem_Util 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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue