From: Arnaud Charlet Date: Tue, 12 May 2015 08:03:06 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ddbc55d8adbf50089321fc531dc047630958b185;p=gcc.git [multiple changes] 2015-05-12 Robert Dewar * sem_util.adb (Is_Variable): Allow X'Deref(Y) as a variable. 2015-05-12 Ed Schonberg * 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 * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9b0e53d89da..c711823259e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2015-05-12 Robert Dewar + + * sem_util.adb (Is_Variable): Allow X'Deref(Y) as a variable. + +2015-05-12 Ed Schonberg + + * 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 + + * 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 + + * 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 * gcc-interface/utils.c (gnat_write_global_declarations): Use type_decl diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 05c805509eb..73eb8140103 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -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. */ diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 40b09e2816d..eed99ffc8df 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -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 diff --git a/gcc/ada/exp_unst.ads b/gcc/ada/exp_unst.ads index 2c554dd979f..39930860f63 100644 --- a/gcc/ada/exp_unst.ads +++ b/gcc/ada/exp_unst.ads @@ -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); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ab9ee00dc68..921b781ea20 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 48d9e52b752..94e1d6248fe 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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.