Skip to content

R
riscv-gcc-1
Commit 437244c7 by Arnaud Charlet
Options

[multiple changes] 

2016-04-27  Arnaud Charlet  <charlet@adacore.com>

	* aa_util.adb, aa_util.ads: Removed, no longer used.

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): An object
	renaming declaration resulting from the expansion of an object
	declaration is a suitable context for pragma Ghost.

2016-04-27  Doug Rupp  <rupp@adacore.com>

	* init.c: Refine last checkin so the only requirement is the
	signaling compilation unit is compiled with the same mode as
	the compilation unit containing the initial landing pad.

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Valid_Default_Iterator): Better filter of illegal
	specifications for Default_Iterator, including overloaded cases
	where no interpretations are legal, and return types that are
	not iterator types.

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): Do not install
	an accessibility check when the left hand side of the assignment
	denotes a container cursor.
	* exp_util.ads, exp_util.adb (Find_Primitive_Operations): Removed.
	* sem_ch4.adb (Find_Indexing_Operations): New routine.
	(Try_Container_Indexing): Code cleanup.

From-SVN: r235505
parent 57323d5b
Showing with 69 additions and 200 deletions
gcc/ada/ChangeLog
2016-04-27 Arnaud Charlet <charlet@adacore.com> 2016-04-27 Arnaud Charlet <charlet@adacore.com>
* aa_util.adb, aa_util.ads: Removed, no longer used.
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): An object
renaming declaration resulting from the expansion of an object
declaration is a suitable context for pragma Ghost.
2016-04-27 Doug Rupp <rupp@adacore.com>
* init.c: Refine last checkin so the only requirement is the
signaling compilation unit is compiled with the same mode as
the compilation unit containing the initial landing pad.
2016-04-27 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Valid_Default_Iterator): Better filter of illegal
specifications for Default_Iterator, including overloaded cases
where no interpretations are legal, and return types that are
not iterator types.
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch5.adb (Expand_N_Assignment_Statement): Do not install
an accessibility check when the left hand side of the assignment
denotes a container cursor.
* exp_util.ads, exp_util.adb (Find_Primitive_Operations): Removed.
* sem_ch4.adb (Find_Indexing_Operations): New routine.
(Try_Container_Indexing): Code cleanup.
2016-04-27 Arnaud Charlet <charlet@adacore.com>
* sem_ch10.adb, sem_case.adb: Mark messages udner -gnatwr when needed. * sem_ch10.adb, sem_case.adb: Mark messages udner -gnatwr when needed.
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com> 2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
......
gcc/ada/aa_util.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAAMP COMPILER COMPONENTS --
-- --
-- A A _ U T I L --
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2011, AdaCore --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
------------------------------------------------------------------------------
-- This package provides various utility operations used by GNAT back-ends
-- (e.g. AAMP).
-- This package is a messy grab bag of stuff. These routines should be moved
-- to appropriate units (sem_util,sem_aux,exp_util,namet,uintp,urealp). ???
with Namet; use Namet;
with Types; use Types;
with Uintp; use Uintp;
with Urealp; use Urealp;
package AA_Util is
function Is_Global_Entity (E : Entity_Id) return Boolean;
-- Returns true if and only if E is a library-level entity (excludes
-- entities declared within blocks at the outer level of library packages).
function New_Name_Id (Name : String) return Name_Id;
-- Returns a Name_Id corresponding to the given name string
function Name_String (Name : Name_Id) return String;
-- Returns the name string associated with Name
function New_String_Id (S : String) return String_Id;
-- Returns a String_Id corresponding to the given string
function String_Value (Str_Id : String_Id) return String;
-- Returns the string associated with Str_Id
-- Name-generation utilities
type Name_Sequencer is private;
-- This type is used to support back-end generation of unique symbol
-- (e.g., for string literal objects or labels). By declaring an
-- aliased object of type Name_Sequence and passing that object
-- to the function Next_Name, a series of names with suffixes
-- of the form "__n" will be produced, where n is a string denoting
-- a positive integer. The sequence starts with "__1", and increases
-- by one on each successive call to Next_Name for a given Name_Sequencer.
function Next_Name
(Name_Seq : not null access Name_Sequencer;
Name_Prefix : String) return Name_Id;
-- Returns the Name_Id for a name composed of the given Name_Prefix
-- concatentated with a unique number suffix of the form "__n",
-- as detemined by the current state of Name_Seq.
function Elab_Spec_Name (Module_Name : Name_Id) return Name_Id;
-- Returns a name id for the elaboration subprogram to be associated with
-- the specification of the named module. The denoted name is of the form
-- "modulename___elabs".
function Elab_Body_Name (Module_Name : Name_Id) return Name_Id;
-- Returns a name id for the elaboration subprogram to be associated
-- with the body of the named module. The denoted name is of the form
-- "modulename___elabb".
function File_Name_Without_Suffix (File_Name : String) return String;
-- Removes the suffix ('.' followed by other characters), if present, from
-- the end of File_Name and returns the shortened name (otherwise simply
-- returns File_Name).
function Source_Name (Sloc : Source_Ptr) return File_Name_Type;
-- Returns file name corresponding to the source file name associated with
-- the given source position Sloc.
function Source_Name_Without_Suffix (Sloc : Source_Ptr) return String;
-- Returns a string corresponding to the source file name associated with
-- the given source position Sloc, with its dot-preceded suffix, if any,
-- removed. As examples, the name "main.adb" is mapped to "main" and the
-- name "main.2.ada" is mapped to "main.2". As a special case, file names
-- with a ".dg" suffix will also strip off the ".dg", so "main.adb.dg"
-- becomes simply "main".
function Source_Id_String (Unit_Name : Name_Id) return String;
-- Returns a string that uniquely identifies the unit with the given
-- Unit_Name. This string is derived from Unit_Name by replacing any
-- multiple underscores with dot ('.') characters and normalizing the
-- casing to mixed case (e.g., "ada__strings" is mapped to ("Ada.Strings").
function Source_Id (Unit_Name : Name_Id) return String_Id;
-- Returns a String_Id reference to a string that uniquely identifies
-- the program unit having the given name (as defined for function
-- Source_Id_String).
function Source_Id_String (Sloc : Source_Ptr) return String;
-- Returns a string that uniquely identifies the source file containing
-- the given source location. This string is constructed from the
-- concatentation of the date and time stamp of the file with a
-- hexadecimal check sum (e.g., "020425143059ABCDEF01").
function Source_Id (Sloc : Source_Ptr) return String_Id;
-- Returns a String_Id reference to a string that uniquely identifies the
-- source file containing the given source location (as defined for
-- function Source_Id_String).
function Image (I : Int) return String;
-- Returns Int'Image (I), but without a leading space in the case where
-- I is nonnegative. Useful for concatenating integers onto other names.
type Integer_Image_Format is (Decimal, Ada_Hex, AAMP_Hex);
function UI_Image (I : Uint; Format : Integer_Image_Format) return String;
-- Returns the image of the universal integer I, with no leading spaces
-- and in the format specified. The Format parameter specifies whether
-- the integer representation should be decimal (the default), or Ada
-- hexadecimal (Ada_Hex => "16#xxxxx#" format), or AAMP hexadecimal.
-- In the latter case, the integer will have the form of a sequence of
-- hexadecimal digits bracketed by '^' characters, and will contain '_'
-- characters as separators for groups of four hexadecimal digits
-- (e.g., ^1C_A3CD^). If the format AAMP_Hex is selected, the universal
-- integer must have a nonnegative value.
function UR_Image (R : Ureal) return String;
-- Returns a decimal image of the universal real value R
private
type Name_Sequencer is record
Sequence_Number : Natural := 0;
end record;
end AA_Util;
gcc/ada/exp_ch5.adb
...@@ -2030,10 +2030,13 @@ package body Exp_Ch5 is ...@@ -2030,10 +2030,13 @@ package body Exp_Ch5 is
end if; end if;
-- Ada 2012 (AI05-148): Update current accessibility level if Rhs is a -- Ada 2012 (AI05-148): Update current accessibility level if Rhs is a
-- stand-alone obj of an anonymous access type. -- stand-alone obj of an anonymous access type. Do not install the check
-- when the Lhs denotes a container cursor and the Next function employs
-- an access type because this may never result in a dangling pointer.
if Is_Access_Type (Typ) if Is_Access_Type (Typ)
and then Is_Entity_Name (Lhs) and then Is_Entity_Name (Lhs)
and then Ekind (Entity (Lhs)) /= E_Loop_Parameter
and then Present (Effective_Extra_Accessibility (Entity (Lhs))) and then Present (Effective_Extra_Accessibility (Entity (Lhs)))
then then
declare declare
......
gcc/ada/exp_util.adb
...@@ -2793,50 +2793,6 @@ package body Exp_Util is ...@@ -2793,50 +2793,6 @@ package body Exp_Util is
end if; end if;
end Find_Optional_Prim_Op; end Find_Optional_Prim_Op;
-------------------------------
-- Find_Primitive_Operations --
-------------------------------
function Find_Primitive_Operations
(T : Entity_Id;
Name : Name_Id) return Node_Id
is
Prim_Elmt : Elmt_Id;
Prim_Id : Entity_Id;
Ref : Node_Id;
Typ : Entity_Id := T;
begin
if Is_Class_Wide_Type (Typ) then
Typ := Root_Type (Typ);
end if;
Typ := Underlying_Type (Typ);
Ref := Empty;
Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
while Present (Prim_Elmt) loop
Prim_Id := Node (Prim_Elmt);
if Chars (Prim_Id) = Name then
-- If this is the first primitive operation found,
-- create a reference to it.
if No (Ref) then
Ref := New_Occurrence_Of (Prim_Id, Sloc (T));
-- Otherwise, add interpretation to existing reference
else
Add_One_Interp (Ref, Prim_Id, Etype (Prim_Id));
end if;
end if;
Next_Elmt (Prim_Elmt);
end loop;
return Ref;
end Find_Primitive_Operations;
------------------ ------------------
-- Find_Prim_Op -- -- Find_Prim_Op --
------------------ ------------------
......
gcc/ada/exp_util.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -473,13 +473,6 @@ package Exp_Util is ...@@ -473,13 +473,6 @@ package Exp_Util is
-- Ada 2005 (AI-251): Given a type T implementing the interface Iface, -- Ada 2005 (AI-251): Given a type T implementing the interface Iface,
-- return the record component containing the tag of Iface. -- return the record component containing the tag of Iface.
function Find_Primitive_Operations
(T : Entity_Id;
Name : Name_Id) return Node_Id;
-- Return a reference to a primitive operation with given name. If
-- operation is overloaded, the node carries the corresponding set
-- of overloaded interpretations.
function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id; function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id;
-- Find the first primitive operation of a tagged type T with name Name. -- Find the first primitive operation of a tagged type T with name Name.
-- This function allows the use of a primitive operation which is not -- This function allows the use of a primitive operation which is not
......
gcc/ada/init.c
...@@ -504,9 +504,13 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext) ...@@ -504,9 +504,13 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
/* ARM Bump has to be an even number because of odd/even architecture. */ /* ARM Bump has to be an even number because of odd/even architecture. */
mcontext->arm_pc+=2; mcontext->arm_pc+=2;
#ifdef __thumb2__ #ifdef __thumb2__
#define CPSR_THUMB_BIT 5
/* For thumb, the return address much have the low order bit set, otherwise /* For thumb, the return address much have the low order bit set, otherwise
the unwwinder will reset to "arm" mode upon return. It's a feature. */ the unwinder will reset to "arm" mode upon return. As long as the
mcontext->arm_pc+=1; compilation unit containing the landing pad is compiled with the same
mode (arm vs thumb) as the signaling compilation unit, this works. */
if (mcontext->arm_cpsr & (1<<CPSR_THUMB_BIT))
mcontext->arm_pc+=1;
#endif #endif
#endif #endif
} }
......
gcc/ada/sem_ch13.adb
...@@ -4323,10 +4323,21 @@ package body Sem_Ch13 is ...@@ -4323,10 +4323,21 @@ package body Sem_Ch13 is
function Valid_Default_Iterator (Subp : Entity_Id) return Boolean is function Valid_Default_Iterator (Subp : Entity_Id) return Boolean is
Formal : Entity_Id; Formal : Entity_Id;
Root_T : constant Entity_Id := Root_Type (Etype (Etype (Subp)));
begin begin
if not Check_Primitive_Function (Subp) then if not Check_Primitive_Function (Subp) then
return False; return False;
-- The return type must be derived from a type in an instance
-- of Iterator.Interfaces, and thus its root type must have a
-- predefined name.
elsif Chars (Root_T) /= Name_Forward_Iterator
and then Chars (Root_T) /= Name_Reversible_Iterator
then
return False;
else else
Formal := First_Formal (Subp); Formal := First_Formal (Subp);
end if; end if;
...@@ -4409,6 +4420,9 @@ package body Sem_Ch13 is ...@@ -4409,6 +4420,9 @@ package body Sem_Ch13 is
if Present (Default) then if Present (Default) then
Set_Entity (Expr, Default); Set_Entity (Expr, Default);
Set_Is_Overloaded (Expr, False); Set_Is_Overloaded (Expr, False);
else
Error_Msg_N
("No interpretation is a valid default iterator!", Expr);
end if; end if;
end; end;
end if; end if;
......
gcc/ada/sem_prag.adb
...@@ -15034,6 +15034,18 @@ package body Sem_Prag is ...@@ -15034,6 +15034,18 @@ package body Sem_Prag is
Id := Defining_Entity (Stmt); Id := Defining_Entity (Stmt);
exit; exit;
-- When pragma Ghost applies to an object declaration which
-- is initialized by means of a function call that returns
-- on the secondary stack, the object declaration becomes a
-- renaming.
elsif Nkind (Stmt) = N_Object_Renaming_Declaration
and then Comes_From_Source (Orig_Stmt)
and then Nkind (Orig_Stmt) = N_Object_Declaration
then
Id := Defining_Entity (Stmt);
exit;
-- When pragma Ghost applies to an expression function, the -- When pragma Ghost applies to an expression function, the
-- expression function is transformed into a subprogram. -- expression function is transformed into a subprogram.
......
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