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>
* 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.
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
end if;
-- 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)
and then Is_Entity_Name (Lhs)
and then Ekind (Entity (Lhs)) /= E_Loop_Parameter
and then Present (Effective_Extra_Accessibility (Entity (Lhs)))
then
declare
......
gcc/ada/exp_util.adb
......@@ -2793,50 +2793,6 @@ package body Exp_Util is
end if;
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 --
------------------
......
gcc/ada/exp_util.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -473,13 +473,6 @@ package Exp_Util is
-- Ada 2005 (AI-251): Given a type T implementing the interface 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;
-- 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
......
gcc/ada/init.c
......@@ -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. */
mcontext->arm_pc+=2;
#ifdef __thumb2__
#define CPSR_THUMB_BIT 5
/* 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. */
mcontext->arm_pc+=1;
the unwinder will reset to "arm" mode upon return. As long as the
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
}
......
gcc/ada/sem_ch13.adb
......@@ -4323,10 +4323,21 @@ package body Sem_Ch13 is
function Valid_Default_Iterator (Subp : Entity_Id) return Boolean is
Formal : Entity_Id;
Root_T : constant Entity_Id := Root_Type (Etype (Etype (Subp)));
begin
if not Check_Primitive_Function (Subp) then
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
Formal := First_Formal (Subp);
end if;
......@@ -4409,6 +4420,9 @@ package body Sem_Ch13 is
if Present (Default) then
Set_Entity (Expr, Default);
Set_Is_Overloaded (Expr, False);
else
Error_Msg_N
("No interpretation is a valid default iterator!", Expr);
end if;
end;
end if;
......
gcc/ada/sem_prag.adb
......@@ -15034,6 +15034,18 @@ package body Sem_Prag is
Id := Defining_Entity (Stmt);
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
-- 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