Skip to content

R
riscv-gcc-1
Commit 47d3b920 by Arnaud Charlet
Options

[multiple changes] 

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* lib-writ.ads, errout.adb, einfo.adb, einfo.ads: Minor reformatting.

2010-06-22  Vincent Celier  <celier@adacore.com>

	* adaint.c (__gnat_locate_regular_file): If a directory in the path is
	empty, make it the current working directory.

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): When deriving a tagged
	private type with discriminants, make sure the parent type is frozen.

2010-06-22  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Bit>: Deal
	with packed array references specially.
	* exp_ch4.adb (Expand_N_Indexed_Component): Do not convert a reference
	to a component of a bit packed array if it is the prefix of 'Bit.
	* exp_pakd.ads (Expand_Packed_Bit_Reference): Declare.
	* exp_pakd.adb (Expand_Packed_Bit_Reference): New procedure.  Expand a
	'Bit reference, where the prefix involves a packed array reference.
	(Get_Base_And_Bit_Offset): New helper, extracted from...
	(Expand_Packed_Address_Reference): ...here.  Call above procedure to
	get the outer object and offset expression.

From-SVN: r161160
parent 5c52bf3b
Showing with 202 additions and 96 deletions
gcc/ada/ChangeLog
2010-06-22 Robert Dewar <dewar@adacore.com>
* lib-writ.ads, errout.adb, einfo.adb, einfo.ads: Minor reformatting.
2010-06-22 Vincent Celier <celier@adacore.com>
* adaint.c (__gnat_locate_regular_file): If a directory in the path is
empty, make it the current working directory.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): When deriving a tagged
private type with discriminants, make sure the parent type is frozen.
2010-06-22 Eric Botcazou <ebotcazou@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Bit>: Deal
with packed array references specially.
* exp_ch4.adb (Expand_N_Indexed_Component): Do not convert a reference
to a component of a bit packed array if it is the prefix of 'Bit.
* exp_pakd.ads (Expand_Packed_Bit_Reference): Declare.
* exp_pakd.adb (Expand_Packed_Bit_Reference): New procedure. Expand a
'Bit reference, where the prefix involves a packed array reference.
(Get_Base_And_Bit_Offset): New helper, extracted from...
(Expand_Packed_Address_Reference): ...here. Call above procedure to
get the outer object and offset expression.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb, lib-writ.ads, bindgen.adb: Minor reformatting.
......
gcc/ada/adaint.c
......@@ -2788,12 +2788,6 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
for (;;)
{
for (; *path_val == PATH_SEPARATOR; path_val++)
;
if (*path_val == 0)
return 0;
/* Skip the starting quote */
if (*path_val == '"')
......@@ -2802,7 +2796,14 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
*ptr++ = *path_val++;
ptr--;
/* If directory is empty, it is the current directory*/
if (ptr == file_path)
{
*ptr = '.';
}
else
ptr--;
/* Skip the ending quote */
......@@ -2816,6 +2817,13 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
if (__gnat_is_regular_file (file_path))
return xstrdup (file_path);
if (*path_val == 0)
return 0;
/* Skip path separator */
path_val++;
}
}
......
gcc/ada/einfo.adb
......@@ -5755,9 +5755,7 @@ package body Einfo is
function Get_Full_View (T : Entity_Id) return Entity_Id is
begin
if Ekind (T) = E_Incomplete_Type
and then Present (Full_View (T))
then
if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
return Full_View (T);
elsif Is_Class_Wide_Type (T)
......
gcc/ada/einfo.ads
......@@ -6821,9 +6821,9 @@ package Einfo is
-- Add an entity to the list of entities declared in the scope V
function Get_Full_View (T : Entity_Id) return Entity_Id;
-- If T is an incomplete type and the full declaration has been
-- seen, or is the name of a class_wide type whose root is incomplete.
-- return the corresponding full declaration.
-- If T is an incomplete type and the full declaration has been seen, or
-- is the name of a class_wide type whose root is incomplete, return the
-- corresponding full declaration, else return T itself.
function Is_Entity_Name (N : Node_Id) return Boolean;
-- Test if the node N is the name of an entity (i.e. is an identifier,
......
gcc/ada/exp_attr.adb
......@@ -1206,6 +1206,20 @@ package body Exp_Attr is
Analyze_And_Resolve (N, RTE (RE_AST_Handler));
end AST_Entry;
---------
-- Bit --
---------
-- We compute this if a packed array reference was present, otherwise we
-- leave the computation up to the back end.
when Attribute_Bit =>
if Involves_Packed_Array_Reference (Pref) then
Expand_Packed_Bit_Reference (N);
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
------------------
-- Bit_Position --
------------------
......@@ -1218,8 +1232,7 @@ package body Exp_Attr is
-- in generated code (i.e. the prefix is an identifier that
-- references the component or discriminant entity).
when Attribute_Bit_Position => Bit_Position :
declare
when Attribute_Bit_Position => Bit_Position : declare
CE : Entity_Id;
begin
......@@ -3232,9 +3245,9 @@ package body Exp_Attr is
-- For enumeration types with a standard representation, Pos is
-- handled by the back end.
-- For enumeration types, with a non-standard representation we
-- generate a call to the _Rep_To_Pos function created when the
-- type was frozen. The call has the form
-- For enumeration types, with a non-standard representation we generate
-- a call to the _Rep_To_Pos function created when the type was frozen.
-- The call has the form
-- _rep_to_pos (expr, flag)
......@@ -3541,6 +3554,7 @@ package body Exp_Attr is
------------------
when Attribute_Range_Length => Range_Length : begin
-- The only special processing required is for the case where
-- Range_Length is applied to an enumeration type with holes.
-- In this case we transform
......@@ -4257,8 +4271,7 @@ package body Exp_Attr is
-- 2. For floating-point, generate call to attribute function
-- 3. For other cases, deal with constraint checking
when Attribute_Succ => Succ :
declare
when Attribute_Succ => Succ : declare
Etyp : constant Entity_Id := Base_Type (Ptyp);
begin
......@@ -4350,8 +4363,7 @@ package body Exp_Attr is
-- Transforms X'Tag into a direct reference to the tag of X
when Attribute_Tag => Tag :
declare
when Attribute_Tag => Tag : declare
Ttyp : Entity_Id;
Prefix_Is_Type : Boolean;
......@@ -4598,8 +4610,7 @@ package body Exp_Attr is
-- with a non-standard representation we use the _Pos_To_Rep array that
-- was created when the type was frozen.
when Attribute_Val => Val :
declare
when Attribute_Val => Val : declare
Etyp : constant Entity_Id := Base_Type (Entity (Pref));
begin
......@@ -4662,8 +4673,7 @@ package body Exp_Attr is
-- The code for valid is dependent on the particular types involved.
-- See separate sections below for the generated code in each case.
when Attribute_Valid => Valid :
declare
when Attribute_Valid => Valid : declare
Btyp : Entity_Id := Base_Type (Ptyp);
Tst : Node_Id;
......@@ -5267,7 +5277,6 @@ package body Exp_Attr is
-- that the result is in range.
when Attribute_Aft |
Attribute_Bit |
Attribute_Max_Size_In_Storage_Elements
=>
Apply_Universal_Integer_Attribute_Checks (N);
......
gcc/ada/exp_ch4.adb
......@@ -4883,7 +4883,7 @@ package body Exp_Ch4 is
-- The second expression in a 'Read attribute reference
-- The prefix of an address or size attribute reference
-- The prefix of an address or bit or size attribute reference
-- The following circuit detects these exceptions
......@@ -4907,6 +4907,8 @@ package body Exp_Ch4 is
elsif Nkind (Parnt) = N_Attribute_Reference
and then (Attribute_Name (Parnt) = Name_Address
or else
Attribute_Name (Parnt) = Name_Bit
or else
Attribute_Name (Parnt) = Name_Size)
and then Prefix (Parnt) = Child
then
......
gcc/ada/exp_pakd.adb
......@@ -455,6 +455,15 @@ package body Exp_Pakd is
-- expression whose type is the implementation type used to represent
-- the packed array. Aexp is analyzed and resolved on entry and on exit.
procedure Get_Base_And_Bit_Offset
(N : Node_Id;
Base : out Node_Id;
Offset : out Node_Id);
-- Given a node N for a name which involves a packed array reference,
-- return the base object of the reference and build an expression of
-- type Standard.Integer representing the zero-based offset in bits
-- from Base'Address to the first bit of the reference.
function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean;
-- There are two versions of the Set routines, the ones used when the
-- object is known to be sufficiently well aligned given the number of
......@@ -1663,18 +1672,11 @@ package body Exp_Pakd is
procedure Expand_Packed_Address_Reference (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Ploc : Source_Ptr;
Pref : Node_Id;
Expr : Node_Id;
Term : Node_Id;
Atyp : Entity_Id;
Subscr : Node_Id;
Base : Node_Id;
Offset : Node_Id;
begin
Pref := Prefix (N);
Expr := Empty;
-- We build up an expression serially that has the form
-- We build an expression that has the form
-- outer_object'Address
-- + (linear-subscript * component_size for each array reference
......@@ -1682,49 +1684,7 @@ package body Exp_Pakd is
-- + ...
-- + ...) / Storage_Unit;
-- Some additional conversions are required to deal with the addition
-- operation, which is not normally visible to generated code.
loop
Ploc := Sloc (Pref);
if Nkind (Pref) = N_Indexed_Component then
Convert_To_Actual_Subtype (Prefix (Pref));
Atyp := Etype (Prefix (Pref));
Compute_Linear_Subscript (Atyp, Pref, Subscr);
Term :=
Make_Op_Multiply (Ploc,
Left_Opnd => Subscr,
Right_Opnd =>
Make_Attribute_Reference (Ploc,
Prefix => New_Occurrence_Of (Atyp, Ploc),
Attribute_Name => Name_Component_Size));
elsif Nkind (Pref) = N_Selected_Component then
Term :=
Make_Attribute_Reference (Ploc,
Prefix => Selector_Name (Pref),
Attribute_Name => Name_Bit_Position);
else
exit;
end if;
Term := Convert_To (RTE (RE_Integer_Address), Term);
if No (Expr) then
Expr := Term;
else
Expr :=
Make_Op_Add (Ploc,
Left_Opnd => Expr,
Right_Opnd => Term);
end if;
Pref := Prefix (Pref);
end loop;
Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
Rewrite (N,
Unchecked_Convert_To (RTE (RE_Address),
......@@ -1732,18 +1692,47 @@ package body Exp_Pakd is
Left_Opnd =>
Unchecked_Convert_To (RTE (RE_Integer_Address),
Make_Attribute_Reference (Loc,
Prefix => Pref,
Prefix => Base,
Attribute_Name => Name_Address)),
Right_Opnd =>
Make_Op_Divide (Loc,
Left_Opnd => Expr,
Right_Opnd =>
Make_Integer_Literal (Loc, System_Storage_Unit)))));
Unchecked_Convert_To (RTE (RE_Integer_Address),
Make_Op_Divide (Loc,
Left_Opnd => Offset,
Right_Opnd =>
Make_Integer_Literal (Loc, System_Storage_Unit))))));
Analyze_And_Resolve (N, RTE (RE_Address));
end Expand_Packed_Address_Reference;
---------------------------------
-- Expand_Packed_Bit_Reference --
---------------------------------
procedure Expand_Packed_Bit_Reference (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Base : Node_Id;
Offset : Node_Id;
begin
-- We build an expression that has the form
-- (linear-subscript * component_size for each array reference
-- + field'Bit_Position for each record field
-- + ...
-- + ...) mod Storage_Unit;
Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
Rewrite (N,
Unchecked_Convert_To (Universal_Integer,
Make_Op_Mod (Loc,
Left_Opnd => Offset,
Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))));
Analyze_And_Resolve (N, Universal_Integer);
end Expand_Packed_Bit_Reference;
------------------------------------
-- Expand_Packed_Boolean_Operator --
------------------------------------
......@@ -2229,6 +2218,70 @@ package body Exp_Pakd is
end Expand_Packed_Not;
-----------------------------
-- Get_Base_And_Bit_Offset --
-----------------------------
procedure Get_Base_And_Bit_Offset
(N : Node_Id;
Base : out Node_Id;
Offset : out Node_Id)
is
Loc : Source_Ptr;
Term : Node_Id;
Atyp : Entity_Id;
Subscr : Node_Id;
begin
Base := N;
Offset := Empty;
-- We build up an expression serially that has the form
-- linear-subscript * component_size for each array reference
-- + field'Bit_Position for each record field
-- + ...
loop
Loc := Sloc (Base);
if Nkind (Base) = N_Indexed_Component then
Convert_To_Actual_Subtype (Prefix (Base));
Atyp := Etype (Prefix (Base));
Compute_Linear_Subscript (Atyp, Base, Subscr);
Term :=
Make_Op_Multiply (Loc,
Left_Opnd => Subscr,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Atyp, Loc),
Attribute_Name => Name_Component_Size));
elsif Nkind (Base) = N_Selected_Component then
Term :=
Make_Attribute_Reference (Loc,
Prefix => Selector_Name (Base),
Attribute_Name => Name_Bit_Position);
else
return;
end if;
if No (Offset) then
Offset := Term;
else
Offset :=
Make_Op_Add (Loc,
Left_Opnd => Offset,
Right_Opnd => Term);
end if;
Base := Prefix (Base);
end loop;
end Get_Base_And_Bit_Offset;
-------------------------------------
-- Involves_Packed_Array_Reference --
-------------------------------------
......
gcc/ada/exp_pakd.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
......@@ -272,4 +272,9 @@ package Exp_Pakd is
-- the prefix involves a packed array reference. This routine expands the
-- necessary code for performing the address reference in this case.
procedure Expand_Packed_Bit_Reference (N : Node_Id);
-- The node N is an attribute reference for the 'Bit reference, where the
-- prefix involves a packed array reference. This routine expands the
-- necessary code for performing the bit reference in this case.
end Exp_Pakd;
gcc/ada/lib-writ.ads
......@@ -696,14 +696,13 @@ package Lib.Writ is
-- reference data. See the spec of Par_SCO for full details of the format.
----------------------
-- Global variables --
-- Global Variables --
----------------------
-- The table structure defined here stores one entry for each
-- Interrupt_State pragma encountered either in the main source or
-- in an ancillary with'ed source. Since interrupt state values
-- have to be consistent across all units in a partition, we may
-- as well detect inconsistencies at compile time when we can.
-- The table defined here stores one entry for each Interrupt_State pragma
-- encountered either in the main source or in an ancillary with'ed source.
-- Since interrupt state values have to be consistent across all units in a
-- partition, we detect inconsistencies at compile time when we can.
type Interrupt_State_Entry is record
Interrupt_Number : Pos;
......
gcc/ada/sem_ch3.adb
......@@ -6790,6 +6790,13 @@ package body Sem_Ch3 is
Mark_Rewrite_Insertion (New_Decl);
Insert_Before (N, New_Decl);
-- In the tagged case, make sure ancestor is frozen appropriately
-- (see also non-discriminated case below).
if not Private_Extension or else Is_Interface (Parent_Base) then
Freeze_Before (New_Decl, Parent_Type);
end if;
-- Note that this call passes False for the Derive_Subps parameter
-- because subprogram derivation is deferred until after creating
-- the subtype (see below).
......@@ -6880,9 +6887,7 @@ package body Sem_Ch3 is
-- The declaration of a specific descendant of an interface type
-- freezes the interface type (RM 13.14).
if not Private_Extension
or else Is_Interface (Parent_Base)
then
if not Private_Extension or else Is_Interface (Parent_Base) then
Freeze_Before (N, Parent_Type);
end if;
......
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