git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* sem_ch9.adb (Check_Node): Allow attributes
	that denote static function for lock-free implementation.
	(Is_Static_Function): New routine.

2012-07-09  Tristan Gingold  <gingold@adacore.com>

	* tracebak.c: Adjust skip_frames on Win64.

2012-07-09  Tristan Gingold  <gingold@adacore.com>

	* init.c: Add __gnat_adjust_context_for_raise for ia64/hpux.
	* raise-gcc.c: __gnat_cleanupunwind_handler: Do not call
	_Unwind_GetGR on hpux when using libgcc unwinder.  Part of

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* exp_attr.adb, sem_attr.adb: Minor reformatting.
	* par-ch13.adb, par-ch4.adb, par-util.adb: Reformatting
	considering that internal attribute names are not defined anymore
	in the main attribute names list.
	* snames.adb-tmpl (Get_Attribute_Id): Special processinf
	for names CPU, Dispatching_Domain and Interrupt_Priority.
	(Is_Internal_Attribute_Name): Minor reformatting.
	* snames.ads-tmpl: New list of internal attribute names. Internal
	attributes moved at the end of the attribute Id list.

From-SVN: r189380
This commit is contained in:
Arnaud Charlet 2012-07-09 15:27:22 +02:00
parent d27f3ff4c3
commit c1107fa376
12 changed files with 161 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2012-07-09 Vincent Pucci <pucci@adacore.com>
* sem_ch9.adb (Check_Node): Allow attributes
that denote static function for lock-free implementation.
(Is_Static_Function): New routine.
2012-07-09 Tristan Gingold <gingold@adacore.com>
* tracebak.c: Adjust skip_frames on Win64.
2012-07-09 Tristan Gingold <gingold@adacore.com>
* init.c: Add __gnat_adjust_context_for_raise for ia64/hpux.
* raise-gcc.c: __gnat_cleanupunwind_handler: Do not call
_Unwind_GetGR on hpux when using libgcc unwinder. Part of
2012-07-09 Vincent Pucci <pucci@adacore.com>
* exp_attr.adb, sem_attr.adb: Minor reformatting.
* par-ch13.adb, par-ch4.adb, par-util.adb: Reformatting
considering that internal attribute names are not defined anymore
in the main attribute names list.
* snames.adb-tmpl (Get_Attribute_Id): Special processinf
for names CPU, Dispatching_Domain and Interrupt_Priority.
(Is_Internal_Attribute_Name): Minor reformatting.
* snames.ads-tmpl: New list of internal attribute names. Internal
attributes moved at the end of the attribute Id list.
2012-07-09 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor code reorganization (use Ekind_In).

4
gcc/ada/exp_attr.adb
View File

@ -841,9 +841,7 @@ package body Exp_Attr is
-- Internal attributes used to deal with Ada 2012 delayed aspects. These
-- were already rejected by the parser. Thus they shouldn't appear here.
when Attribute_CPU |
Attribute_Dispatching_Domain |
Attribute_Interrupt_Priority =>
when Internal_Attribute_Id =>
raise Program_Error;
------------

23
gcc/ada/init.c
View File

@ -304,6 +304,25 @@ __gnat_install_handler (void)
#include <signal.h>
#include <sys/ucontext.h>
#if defined(__ia64__)
#include <sys/uc_access.h>
#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
void
__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
{
ucontext_t *uc = (ucontext_t *) ucontext;
uint64_t ip;
/* Adjust on itanium, as GetIPInfo is not supported. */
__uc_get_ip (uc, &ip);
__uc_set_ip (uc, ip + 1);
}
#endif /* __ia64__ */
/* Tasking and Non-tasking signal handler. Map SIGnal to Ada exception
propagation after the required low level adjustments. */
static void
__gnat_error_handler (int sig,
siginfo_t *si ATTRIBUTE_UNUSED,
@ -312,6 +331,10 @@ __gnat_error_handler (int sig,
struct Exception_Data *exception;
const char *msg;
#if defined(__ia64__)
__gnat_adjust_context_for_raise (sig, ucontext);
#endif
switch (sig)
{
case SIGSEGV:

4
gcc/ada/par-ch13.adb
View File

@ -226,8 +226,8 @@ package body Ch13 is
-- are meant to be used only by the compiler.
if not Is_Attribute_Name (Attr_Name)
or else (Is_Internal_Attribute_Name (Attr_Name)
and then Comes_From_Source (Token_Node))
and then (not Is_Internal_Attribute_Name (Attr_Name)
or else Comes_From_Source (Token_Node))
then
Signal_Bad_Attribute;
end if;

8
gcc/ada/par-ch4.adb
View File

@ -434,13 +434,7 @@ package body Ch4 is
elsif Token = Tok_Identifier then
Attr_Name := Token_Name;
-- Note that internal attributes names don't denote real
-- attributes, so do not count in this error test. We just
-- want to consider them as not being attribute names.
if not Is_Attribute_Name (Attr_Name)
or else Is_Internal_Attribute_Name (Attr_Name)
then
if not Is_Attribute_Name (Attr_Name) then
if Apostrophe_Should_Be_Semicolon then
Expr_Form := EF_Name;
return Name_Node;

8
gcc/ada/par-util.adb
View File

@ -721,13 +721,7 @@ package body Util is
Error_Msg_Name_1 := First_Attribute_Name;
while Error_Msg_Name_1 <= Last_Attribute_Name loop
-- No mispelling possible with internal attribute names since they
-- don't denote real attributes.
if not Is_Internal_Attribute_Name (Error_Msg_Name_1)
and then Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1)
then
if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then
Error_Msg_N -- CODEFIX
("\possible misspelling of %", Token_Node);
exit;

2
gcc/ada/raise-gcc.c
View File

@ -1167,7 +1167,7 @@ __gnat_cleanupunwind_handler (int version,
{
/* Terminate when the end of the stack is reached. */
if ((phases & _UA_END_OF_STACK) != 0
#if defined (__ia64__) && defined (__hpux__)
#if defined (__ia64__) && defined (__hpux__) && defined (USE_LIBUNWIND_EXCEPTIONS)
/* Strictely follow the ia64 ABI: when end of stack is reached,
the callback will be called with a NULL stack pointer.
No need for that when using libgcc unwinder. */

4
gcc/ada/sem_attr.adb
View File

@ -2218,9 +2218,7 @@ package body Sem_Attr is
-- Internal attributes used to deal with Ada 2012 delayed aspects. These
-- were already rejected by the parser. Thus they shouldn't appear here.
when Attribute_CPU |
Attribute_Dispatching_Domain |
Attribute_Interrupt_Priority =>
when Internal_Attribute_Id =>
raise Program_Error;
------------------

63
gcc/ada/sem_ch9.adb
View File

@ -244,12 +244,71 @@ package body Sem_Ch9 is
----------------
function Check_Node (N : Node_Id) return Traverse_Result is
function Is_Static_Function (Attr : Node_Id) return Boolean;
-- Given an attribute reference node Attr, return True if
-- Attr denotes a static function according to the rules in
-- (RM 4.9 (22)).
------------------------
-- Is_Static_Function --
------------------------
function Is_Static_Function
(Attr : Node_Id) return Boolean
is
Para : Node_Id;
begin
pragma Assert (Nkind (Attr) = N_Attribute_Reference);
case Attribute_Name (Attr) is
when Name_Min |
Name_Max |
Name_Pred |
Name_Succ |
Name_Value |
Name_Wide_Value |
Name_Wide_Wide_Value =>
-- A language-defined attribute denotes a static
-- function if the prefix denotes a static scalar
-- subtype, and if the parameter and result types
-- are scalar (RM 4.9 (22)).
if Is_Scalar_Type (Etype (Attr))
and then Is_Scalar_Type (Etype (Prefix (Attr)))
and then Is_Static_Subtype (Etype (Prefix (Attr)))
then
Para := First (Expressions (Attr));
while Present (Para) loop
if not Is_Scalar_Type (Etype (Para)) then
return False;
end if;
Next (Para);
end loop;
return True;
else
return False;
end if;
when others => return False;
end case;
end Is_Static_Function;
-- Start of processing for Check_Node
begin
if Is_Procedure then
-- Function calls and attribute references must be static
-- Attribute references must be static or denote a static
-- function.
if Nkind (N) = N_Attribute_Reference
and then not Is_Static_Expression (N)
and then not Is_Static_Function (N)
then
if Complain then
Error_Msg_N
@ -258,6 +317,8 @@ package body Sem_Ch9 is
return Abandon;
-- Function calls must be static
elsif Nkind (N) = N_Function_Call
and then not Is_Static_Expression (N)
then

14
gcc/ada/snames.adb-tmpl
View File

@ -127,7 +127,15 @@ package body Snames is
function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
begin
return Attribute_Id'Val (N - First_Attribute_Name);
if N = Name_CPU then
return Attribute_CPU;
elsif N = Name_Dispatching_Domain then
return Attribute_Dispatching_Domain;
elsif N = Name_Interrupt_Priority then
return Attribute_Interrupt_Priority;
else
return Attribute_Id'Val (N - First_Attribute_Name);
end if;
end Get_Attribute_Id;
-----------------------
@ -399,9 +407,7 @@ package body Snames is
function Is_Internal_Attribute_Name (N : Name_Id) return Boolean is
begin
return
N = Name_CPU or else
N = Name_Interrupt_Priority or else
N = Name_Dispatching_Domain;
N in First_Internal_Attribute_Name .. Last_Internal_Attribute_Name;
end Is_Internal_Attribute_Name;
----------------------------

46
gcc/ada/snames.ads-tmpl
View File

@ -753,14 +753,6 @@ package Snames is
-- implementation dependent attributes may be found in the appropriate
-- section in Sem_Attr.
-- The entries marked INT are not real attributes. They are special names
-- used internally by GNAT in order to deal with certain delayed aspects
-- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that
-- don't have corresponding pragmas or user-referencable attributes. It is
-- convenient to have these internal attributes available in processing
-- the aspects, since the normal approach is to convert an aspect into its
-- corresponding pragma or attribute specification.
-- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts.
@ -787,7 +779,6 @@ package Snames is
Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT
Name_Constrained : constant Name_Id := N + $;
Name_Count : constant Name_Id := N + $;
Name_CPU : constant Name_Id := N + $; -- INT
Name_Default_Bit_Order : constant Name_Id := N + $; -- GNAT
Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
Name_Definite : constant Name_Id := N + $;
@ -795,7 +786,6 @@ package Snames is
Name_Denorm : constant Name_Id := N + $;
Name_Descriptor_Size : constant Name_Id := N + $;
Name_Digits : constant Name_Id := N + $;
Name_Dispatching_Domain : constant Name_Id := N + $; -- INT
Name_Elaborated : constant Name_Id := N + $; -- GNAT
Name_Emax : constant Name_Id := N + $; -- Ada 83
Name_Enabled : constant Name_Id := N + $; -- GNAT
@ -817,7 +807,6 @@ package Snames is
Name_Img : constant Name_Id := N + $; -- GNAT
Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT
Name_Integer_Value : constant Name_Id := N + $; -- GNAT
Name_Interrupt_Priority : constant Name_Id := N + $; -- INT
Name_Invalid_Value : constant Name_Id := N + $; -- GNAT
Name_Iterator_Element : constant Name_Id := N + $; -- GNAT
Name_Large : constant Name_Id := N + $; -- Ada 83
@ -963,6 +952,21 @@ package Snames is
Last_Entity_Attribute_Name : constant Name_Id := N + $;
Last_Attribute_Name : constant Name_Id := N + $;
-- Names of internal attributes. They are not real attributes but special
-- names used internally by GNAT in order to deal with certain delayed
-- aspects (Aspect_CPU, Aspect_Dispatching_Domain,
-- Aspect_Interrupt_Priority) that don't have corresponding pragmas or
-- user-referencable attributes. It is convenient to have these internal
-- attributes available in processing the aspects, since the normal
-- approach is to convert an aspect into its corresponding pragma or
-- attribute specification.
First_Internal_Attribute_Name : constant Name_Id := N + $;
Name_CPU : constant Name_Id := N + $; -- INT
Name_Dispatching_Domain : constant Name_Id := N + $; -- INT
Name_Interrupt_Priority : constant Name_Id := N + $; -- INT
Last_Internal_Attribute_Name : constant Name_Id := N + $;
-- Names of recognized locking policy identifiers
First_Locking_Policy_Name : constant Name_Id := N + $;
@ -1366,7 +1370,6 @@ package Snames is
Attribute_Constant_Indexing,
Attribute_Constrained,
Attribute_Count,
Attribute_CPU,
Attribute_Default_Bit_Order,
Attribute_Default_Iterator,
Attribute_Definite,
@ -1374,7 +1377,6 @@ package Snames is
Attribute_Denorm,
Attribute_Descriptor_Size,
Attribute_Digits,
Attribute_Dispatching_Domain,
Attribute_Elaborated,
Attribute_Emax,
Attribute_Enabled,
@ -1396,7 +1398,6 @@ package Snames is
Attribute_Img,
Attribute_Implicit_Dereference,
Attribute_Integer_Value,
Attribute_Interrupt_Priority,
Attribute_Invalid_Value,
Attribute_Iterator_Element,
Attribute_Large,
@ -1526,7 +1527,18 @@ package Snames is
Attribute_Base,
Attribute_Class,
Attribute_Stub_Type);
Attribute_Stub_Type,
-- The internal attributes are on their own, out of order, because of
-- the special processing required to deal with the fact that their
-- names are not attribute names.
Attribute_CPU,
Attribute_Dispatching_Domain,
Attribute_Interrupt_Priority);
subtype Internal_Attribute_Id is Attribute_Id range
Attribute_CPU .. Attribute_Interrupt_Priority;
type Attribute_Class_Array is array (Attribute_Id) of Boolean;
-- Type used to build attribute classification flag arrays
@ -1897,7 +1909,9 @@ package Snames is
function Get_Attribute_Id (N : Name_Id) return Attribute_Id;
-- Returns Id of attribute corresponding to given name. It is an error to
-- call this function with a name that is not the name of a attribute.
-- call this function with a name that is not the name of a attribute. Note
-- that the function also works correctly for internal attribute names even
-- though there are not included in the main list of attribute Names.
function Get_Convention_Id (N : Name_Id) return Convention_Id;
-- Returns Id of language convention corresponding to given name. It is

2
gcc/ada/tracebak.c
View File

@ -160,7 +160,7 @@ __gnat_backtrace (void **array,
break;
/* Skip frames. */
if (skip_frames)
if (skip_frames > 1)
{
skip_frames--;
continue;