Skip to content

R
riscv-gcc-1
Commit ddbc55d8 by Arnaud Charlet
Options

[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
parent 3a857fd0
Showing with 105 additions and 52 deletions
gcc/ada/ChangeLog
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
......
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. */
......
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
......
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);
......
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;
......
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.
......
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