Commit e3b3266c by Arnaud Charlet

[multiple changes]

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

	* treepr.adb, treepr.ads: Revert previous patch, unneeded.

2012-07-17  Robert Dewar  <dewar@adacore.com>

	* s-assert.ads: Fix comments to make it clear that this is used
	for all assertions, not just pragma Assert.

2012-07-17  Jerome Guitton  <guitton@adacore.com>

	* par_sco.ads: Minor typo fix.

2012-07-17  Gary Dismukes  <dismukes@adacore.com>

	* layout.adb (Layout_Type): In the case where the target is
	AAMP, use 32 bits (a single pointer) rather than 64 bits for an
	anonymous access-to-subprogram type if the type is library-level
	and Is_Local_Anonymous_Access is True.

2012-07-17  Jose Ruiz  <ruiz@adacore.com>

	* s-tassta.adb, s-tarest.adb (Create_Task, Create_Restricted_Task,
	Initialize): Add comments explaining that the CPU affinity value that
	is passed to the run-time library can be either Unspecified_CPU, to
	indicate that the task inherits the affinity of its activating task,
	or a value in the range of CPU_Range but no greater than Number_Of_CPUs.

2012-07-17  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_DT): Remove decoration of Ada.Tags entities.
	(Make_Tags): Add decoration of Ada.Tags entities.

2012-07-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Statement_Sequence): When locating the
	last significant statement in a sequence, ignore iserted nodes
	that typically come from expansion of controlled operations.

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

	* gnat_rm.texi: Document foreign exceptions.

From-SVN: r189568
parent 2761f6e9
2012-07-17 Robert Dewar <dewar@adacore.com> 2012-07-17 Robert Dewar <dewar@adacore.com>
* s-assert.ads: Fix comments to make it clear that this is used
for all assertions, not just pragma Assert.
2012-07-17 Jerome Guitton <guitton@adacore.com>
* par_sco.ads: Minor typo fix.
2012-07-17 Gary Dismukes <dismukes@adacore.com>
* layout.adb (Layout_Type): In the case where the target is
AAMP, use 32 bits (a single pointer) rather than 64 bits for an
anonymous access-to-subprogram type if the type is library-level
and Is_Local_Anonymous_Access is True.
2012-07-17 Jose Ruiz <ruiz@adacore.com>
* s-tassta.adb, s-tarest.adb (Create_Task, Create_Restricted_Task,
Initialize): Add comments explaining that the CPU affinity value that
is passed to the run-time library can be either Unspecified_CPU, to
indicate that the task inherits the affinity of its activating task,
or a value in the range of CPU_Range but no greater than Number_Of_CPUs.
2012-07-17 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Make_DT): Remove decoration of Ada.Tags entities.
(Make_Tags): Add decoration of Ada.Tags entities.
2012-07-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Check_Statement_Sequence): When locating the
last significant statement in a sequence, ignore iserted nodes
that typically come from expansion of controlled operations.
2012-07-17 Tristan Gingold <gingold@adacore.com>
* gnat_rm.texi: Document foreign exceptions.
2012-07-17 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, treepr.ads: Minor reformatting. * sem_prag.adb, treepr.ads: Minor reformatting.
2012-07-17 Robert Dewar <dewar@adacore.com> 2012-07-17 Robert Dewar <dewar@adacore.com>
...@@ -12,13 +51,6 @@ ...@@ -12,13 +51,6 @@
* seh_init.c (__gnat_SEH_error_handler): Not compiled anymore * seh_init.c (__gnat_SEH_error_handler): Not compiled anymore
on Windows 64 (+ SEH), as it is unused. on Windows 64 (+ SEH), as it is unused.
2012-07-17 Tristan Gingold <gingold@adacore.com>
* treepr.ads (psloc): Declare.
* treepr.adb (psloc): New debug procedure to print a sloc.
(Print_Sloc): New procedure, from ...
(Print_Node_Subtree): ... this. Call Print_Sloc.
2012-07-17 Javier Miranda <miranda@adacore.com> 2012-07-17 Javier Miranda <miranda@adacore.com>
* sem_prag.adb (CPP_Class): Transform obsolescent pragma CPP_Class into * sem_prag.adb (CPP_Class): Transform obsolescent pragma CPP_Class into
......
...@@ -6255,12 +6255,6 @@ package body Exp_Disp is ...@@ -6255,12 +6255,6 @@ package body Exp_Disp is
Elmt : Elmt_Id; Elmt : Elmt_Id;
begin begin
-- Ensure that entities Prim_Ptr and Predef_Prims_Table_Ptr have
-- the decoration required by the backend
Set_Is_Dispatch_Table_Entity (RTE (RE_Prim_Ptr));
Set_Is_Dispatch_Table_Entity (RTE (RE_Predef_Prims_Table_Ptr));
-- Object declarations -- Object declarations
Elmt := First_Elmt (DT_Decl); Elmt := First_Elmt (DT_Decl);
...@@ -7137,6 +7131,12 @@ package body Exp_Disp is ...@@ -7137,6 +7131,12 @@ package body Exp_Disp is
Set_Ekind (DT_Ptr, E_Variable); Set_Ekind (DT_Ptr, E_Variable);
Set_Related_Type (DT_Ptr, Typ); Set_Related_Type (DT_Ptr, Typ);
-- Ensure that entities Prim_Ptr and Predef_Prims_Table_Ptr have
-- the decoration required by the backend
Set_Is_Dispatch_Table_Entity (RTE (RE_Prim_Ptr));
Set_Is_Dispatch_Table_Entity (RTE (RE_Predef_Prims_Table_Ptr));
-- For CPP types there is no need to build the dispatch tables since -- For CPP types there is no need to build the dispatch tables since
-- they are imported from the C++ side. If the CPP type has an IP then -- they are imported from the C++ side. If the CPP type has an IP then
-- we declare now the variable that will store the copy of the C++ tag. -- we declare now the variable that will store the copy of the C++ tag.
......
...@@ -1869,8 +1869,6 @@ functions (see pragma @code{CPP_Constructor}). Such types are implicitly ...@@ -1869,8 +1869,6 @@ functions (see pragma @code{CPP_Constructor}). Such types are implicitly
limited if not explicitly declared as limited or derived from a limited limited if not explicitly declared as limited or derived from a limited
type, and an error is issued in that case. type, and an error is issued in that case.
Pragma @code{CPP_Class} is intended primarily for automatic generation
using an automatic binding generator tool.
See @ref{Interfacing to C++} for related information. See @ref{Interfacing to C++} for related information.
Note: Pragma @code{CPP_Class} is currently obsolete. It is supported Note: Pragma @code{CPP_Class} is currently obsolete. It is supported
...@@ -1927,7 +1925,8 @@ If no constructors are imported, it is impossible to create any objects ...@@ -1927,7 +1925,8 @@ If no constructors are imported, it is impossible to create any objects
on the Ada side and the type is implicitly declared abstract. on the Ada side and the type is implicitly declared abstract.
Pragma @code{CPP_Constructor} is intended primarily for automatic generation Pragma @code{CPP_Constructor} is intended primarily for automatic generation
using an automatic binding generator tool. using an automatic binding generator tool (such as the @code{-fdump-ada-spec}
GCC switch).
See @ref{Interfacing to C++} for more related information. See @ref{Interfacing to C++} for more related information.
Note: The use of functions returning class-wide types for constructors is Note: The use of functions returning class-wide types for constructors is
...@@ -16617,8 +16616,7 @@ of the length corresponding to the @code{@var{type}'Size} value in Ada. ...@@ -16617,8 +16616,7 @@ of the length corresponding to the @code{@var{type}'Size} value in Ada.
@noindent @noindent
The interface to C++ makes use of the following pragmas, which are The interface to C++ makes use of the following pragmas, which are
primarily intended to be constructed automatically using a binding generator primarily intended to be constructed automatically using a binding generator
tool, although it is possible to construct them by hand. No suitable binding tool, although it is possible to construct them by hand.
generator tool is supplied with GNAT though.
Using these pragmas it is possible to achieve complete Using these pragmas it is possible to achieve complete
inter-operability between Ada tagged types and C++ class definitions. inter-operability between Ada tagged types and C++ class definitions.
...@@ -16640,6 +16638,11 @@ This pragma identifies an imported function (imported in the usual way ...@@ -16640,6 +16638,11 @@ This pragma identifies an imported function (imported in the usual way
with pragma @code{Import}) as corresponding to a C++ constructor. with pragma @code{Import}) as corresponding to a C++ constructor.
@end table @end table
In addition, C++ exceptions are propagated and can be handled in a
@code{others} choice of an exception handler. The corresponding Ada
occurrence has no message, and the simple name of the exception identity
contains @samp{Foreign_Exception}.
@node Interfacing to COBOL @node Interfacing to COBOL
@section Interfacing to COBOL @section Interfacing to COBOL
......
...@@ -2452,15 +2452,20 @@ package body Layout is ...@@ -2452,15 +2452,20 @@ package body Layout is
Init_Size (E, 2 * System_Address_Size); Init_Size (E, 2 * System_Address_Size);
-- When the target is AAMP, access-to-subprogram types are fat -- When the target is AAMP, access-to-subprogram types are fat
-- pointers consisting of the subprogram address and a static link -- pointers consisting of the subprogram address and a static link,
-- (with the exception of library-level access types, where a simple -- with the exception of library-level access types (including
-- subprogram address is used). -- library-level anonymous access types, such as for components),
-- where a simple subprogram address is used.
elsif AAMP_On_Target elsif AAMP_On_Target
and then and then
(Ekind (E) = E_Anonymous_Access_Subprogram_Type ((Ekind (E) = E_Access_Subprogram_Type
or else (Ekind (E) = E_Access_Subprogram_Type and then Present (Enclosing_Subprogram (E)))
and then Present (Enclosing_Subprogram (E)))) or else
(Ekind (E) = E_Anonymous_Access_Subprogram_Type
and then
(not Is_Local_Anonymous_Access (E)
or else Present (Enclosing_Subprogram (E)))))
then then
Init_Size (E, 2 * System_Address_Size); Init_Size (E, 2 * System_Address_Size);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2009-2011, Free Software Foundation, Inc. -- -- Copyright (C) 2009-2012, 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- --
...@@ -24,7 +24,7 @@ ...@@ -24,7 +24,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package contains the routines used to deal with generation and output -- This package contains the routines used to deal with generation and output
-- of Soure Coverage Obligations (SCO's) used for coverage analysis purposes. -- of Source Coverage Obligations (SCO's) used for coverage analysis purposes.
-- See package SCOs for full documentation of format of SCO information. -- See package SCOs for full documentation of format of SCO information.
with Types; use Types; with Types; use Types;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, 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- --
...@@ -29,7 +29,9 @@ ...@@ -29,7 +29,9 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package provides support for the GNAT assert pragma -- This package provides support for assertions (including pragma Assert,
-- pragma Debug, and Precondition/Postcondition/Predicate/Invariant aspects
-- and their corresponding pragmas).
-- This unit may be used directly from an application program by providing -- This unit may be used directly from an application program by providing
-- an appropriate WITH, and the interface can be expected to remain stable. -- an appropriate WITH, and the interface can be expected to remain stable.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1999-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- GNARL 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- --
...@@ -483,6 +483,12 @@ package body System.Tasking.Restricted.Stages is ...@@ -483,6 +483,12 @@ package body System.Tasking.Restricted.Stages is
then Self_ID.Common.Base_Priority then Self_ID.Common.Base_Priority
else System.Any_Priority (Priority)); else System.Any_Priority (Priority));
-- Legal values of CPU are the special Unspecified_CPU value which is
-- inserted by the compiler for tasks without CPU aspect, and those in
-- the range of CPU_Range but no greater than Number_Of_CPUs. Otherwise
-- the task is defined to have failed, and it becomes a completed task
-- (RM D.16(14/3)).
if CPU /= Unspecified_CPU if CPU /= Unspecified_CPU
and then (CPU < Integer (System.Multiprocessors.CPU_Range'First) and then (CPU < Integer (System.Multiprocessors.CPU_Range'First)
or else CPU > Integer (System.Multiprocessors.CPU_Range'Last) or else CPU > Integer (System.Multiprocessors.CPU_Range'Last)
...@@ -492,6 +498,13 @@ package body System.Tasking.Restricted.Stages is ...@@ -492,6 +498,13 @@ package body System.Tasking.Restricted.Stages is
-- Normal CPU affinity -- Normal CPU affinity
else else
-- When the application code says nothing about the task affinity
-- (task without CPU aspect) then the compiler inserts the
-- Unspecified_CPU value which indicates to the run-time library that
-- the task will activate and execute on the same processor as its
-- activating task if the activating task is assigned a processor
-- (RM D.16(14/3)).
Base_CPU := Base_CPU :=
(if CPU = Unspecified_CPU (if CPU = Unspecified_CPU
then Self_ID.Common.Base_CPU then Self_ID.Common.Base_CPU
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- GNARL 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- --
...@@ -527,6 +527,12 @@ package body System.Tasking.Stages is ...@@ -527,6 +527,12 @@ package body System.Tasking.Stages is
then Self_ID.Common.Base_Priority then Self_ID.Common.Base_Priority
else System.Any_Priority (Priority)); else System.Any_Priority (Priority));
-- Legal values of CPU are the special Unspecified_CPU value which is
-- inserted by the compiler for tasks without CPU aspect, and those in
-- the range of CPU_Range but no greater than Number_Of_CPUs. Otherwise
-- the task is defined to have failed, and it becomes a completed task
-- (RM D.16(14/3)).
if CPU /= Unspecified_CPU if CPU /= Unspecified_CPU
and then (CPU < Integer (System.Multiprocessors.CPU_Range'First) and then (CPU < Integer (System.Multiprocessors.CPU_Range'First)
or else or else
...@@ -539,6 +545,13 @@ package body System.Tasking.Stages is ...@@ -539,6 +545,13 @@ package body System.Tasking.Stages is
-- Normal CPU affinity -- Normal CPU affinity
else else
-- When the application code says nothing about the task affinity
-- (task without CPU aspect) then the compiler inserts the
-- Unspecified_CPU value which indicates to the run-time library that
-- the task will activate and execute on the same processor as its
-- activating task if the activating task is assigned a processor
-- (RM D.16(14/3)).
Base_CPU := Base_CPU :=
(if CPU = Unspecified_CPU (if CPU = Unspecified_CPU
then Self_ID.Common.Base_CPU then Self_ID.Common.Base_CPU
......
...@@ -6633,6 +6633,11 @@ package body Sem_Ch6 is ...@@ -6633,6 +6633,11 @@ package body Sem_Ch6 is
and then Exception_Junk (Last_Stm)) and then Exception_Junk (Last_Stm))
or else Nkind (Last_Stm) in N_Push_xxx_Label or else Nkind (Last_Stm) in N_Push_xxx_Label
or else Nkind (Last_Stm) in N_Pop_xxx_Label or else Nkind (Last_Stm) in N_Pop_xxx_Label
-- Inserted code, such as finalization calls, is irrelevant: we only
-- need to check original source.
or else Is_Rewrite_Insertion (Last_Stm)
loop loop
Prev (Last_Stm); Prev (Last_Stm);
end loop; end loop;
......
...@@ -188,9 +188,6 @@ package body Treepr is ...@@ -188,9 +188,6 @@ package body Treepr is
-- level and the bars used to link list elements). In addition, for lines -- level and the bars used to link list elements). In addition, for lines
-- other than the first, an additional character Prefix_Char is output. -- other than the first, an additional character Prefix_Char is output.
procedure Print_Sloc (Loc : Source_Ptr);
-- Print the human readable representation of Loc
function Serial_Number (Id : Int) return Nat; function Serial_Number (Id : Int) return Nat;
-- Given a Node_Id, List_Id or Elist_Id, returns the previously assigned -- Given a Node_Id, List_Id or Elist_Id, returns the previously assigned
-- serial number, or zero if no serial number has yet been assigned. -- serial number, or zero if no serial number has yet been assigned.
...@@ -890,6 +887,7 @@ package body Treepr is ...@@ -890,6 +887,7 @@ package body Treepr is
Field_To_Be_Printed : Boolean; Field_To_Be_Printed : Boolean;
Prefix_Str_Char : String (Prefix_Str'First .. Prefix_Str'Last + 1); Prefix_Str_Char : String (Prefix_Str'First .. Prefix_Str'Last + 1);
Sfile : Source_File_Index;
Fmt : UI_Format; Fmt : UI_Format;
begin begin
...@@ -935,7 +933,20 @@ package body Treepr is ...@@ -935,7 +933,20 @@ package body Treepr is
Print_Str (Prefix_Str_Char); Print_Str (Prefix_Str_Char);
Print_Str ("Sloc = "); Print_Str ("Sloc = ");
Print_Sloc (Sloc (N)); if Sloc (N) = Standard_Location then
Print_Str ("Standard_Location");
elsif Sloc (N) = Standard_ASCII_Location then
Print_Str ("Standard_ASCII_Location");
else
Sfile := Get_Source_File_Index (Sloc (N));
Print_Int (Int (Sloc (N)) - Int (Source_Text (Sfile)'First));
Write_Str (" ");
Write_Location (Sloc (N));
end if;
Print_Eol;
end if; end if;
-- Print Chars field if present -- Print Chars field if present
...@@ -1386,30 +1397,6 @@ package body Treepr is ...@@ -1386,30 +1397,6 @@ package body Treepr is
Print_Term; Print_Term;
end Print_Node_Subtree; end Print_Node_Subtree;
----------------
-- Print_Sloc --
----------------
procedure Print_Sloc (Loc : Source_Ptr) is
Sfile : Source_File_Index;
begin
if Loc = Standard_Location then
Print_Str ("Standard_Location");
elsif Loc = Standard_ASCII_Location then
Print_Str ("Standard_ASCII_Location");
else
Sfile := Get_Source_File_Index (Loc);
Print_Int (Int (Loc) - Int (Source_Text (Sfile)'First));
Write_Str (" ");
Write_Location (Loc);
end if;
Print_Eol;
end Print_Sloc;
--------------- ---------------
-- Print_Str -- -- Print_Str --
--------------- ---------------
...@@ -1537,16 +1524,6 @@ package body Treepr is ...@@ -1537,16 +1524,6 @@ package body Treepr is
Print_Node (N, Label, ' '); Print_Node (N, Label, ' ');
end Print_Tree_Node; end Print_Tree_Node;
-----------
-- psloc --
-----------
procedure psloc (Loc : Source_Ptr) is
begin
Phase := Printing;
Print_Sloc (Loc);
end psloc;
-------- --------
-- pt -- -- pt --
-------- --------
......
...@@ -71,11 +71,6 @@ package Treepr is ...@@ -71,11 +71,6 @@ package Treepr is
pragma Export (Ada, ppp); pragma Export (Ada, ppp);
-- Same as Print_Node_Subtree -- Same as Print_Node_Subtree
procedure psloc (Loc : Source_Ptr);
pragma Export (Ada, psloc);
-- Prints the sloc Loc
-- Why is this here??? use the routines in Sprint instead ???
-- The following are no longer needed; you can use pp or ppp instead -- The following are no longer needed; you can use pp or ppp instead
procedure pe (E : Elist_Id); procedure pe (E : Elist_Id);
......
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