[./]

2013-11-12  Basile Starynkevitch  <basile@starynkevitch.net>

	{{merge with trunk GCC 4.9 svn rev 204695; previous trunk merge
	was 202773; very unstable...}}

[gcc/]

2013-11-11  Basile Starynkevitch  <basile@starynkevitch.net>

	{{merge with trunk GCC 4.9 svn rev 204695; very unstable}}
	* melt-runtime.h (MELT_VERSION_STRING): Bump to "1.0.1+".

	* melt-run.proto.h: Update copyright years.
	include tree-cfg.h instead of tree-flow.h for GCC 4.9.

	* melt-runtime.cc: Include tree-cfg.h not tree-flow.h for GCC 4.9.
	(meltgc_walk_gimple_seq): Fatal error with GCC 4.9 since the
	walk_use_def_chains function disappeared from GCC...

	* melt/xtramelt-ana-gimple.melt (walk_gimple_seq)
	(walk_gimple_seq_unique_tree): issue some #warning-s for GCC 4.9
	because walk_use_def_chains function disappeared from GCC...

	* melt/xtramelt-probe.melt (probe_docmd): Issue an error since
	currently the MELT probe is not usable with GCC 4.9....



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@204705 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 123 insertions, 23 deletions

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index eeafa72d356..693aac9b35f 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -311,6 +311,10 @@ package body Exp_Prag is
       --  at" is omitted for name = Assertion, since it is redundant, given
       --  that the name of the exception is Assert_Failure.)
 
+      --  Also, instead of "XXX failed at", we generate slightly
+      --  different messages for some of the contract assertions (see
+      --  code below for details).
+
       --  An alternative expansion is used when the No_Exception_Propagation
       --  restriction is active and there is a local Assert_Failure handler.
       --  This is not a common combination of circumstances, but it occurs in
@@ -400,6 +404,15 @@ package body Exp_Prag is
                   Insert_Str_In_Name_Buffer ("failed ", 1);
                   Add_Str_To_Name_Buffer (" from ");
 
+               --  For special case of Invariant, the string is "failed
+               --  invariant from yy", to be consistent with the string that is
+               --  generated for the aspect case (the code later on checks for
+               --  this specific string to modify it in some cases, so this is
+               --  functionally important).
+
+               elsif Nam = Name_Invariant then
+                  Add_Str_To_Name_Buffer ("failed invariant from ");
+
                --  For all other checks, the string is "xxx failed at yyy"
                --  where xxx is the check name with current source file casing.
 
@@ -530,30 +543,34 @@ package body Exp_Prag is
    -- Expand_Pragma_Import_Or_Interface --
    ---------------------------------------
 
-   --  When applied to a variable, the default initialization must not be done.
-   --  As it is already done when the pragma is found, we just get rid of the
-   --  call the initialization procedure which followed the object declaration.
-   --  The call is inserted after the declaration, but validity checks may
-   --  also have been inserted and the initialization call does not necessarily
-   --  appear immediately after the object declaration.
-
-   --  We can't use the freezing mechanism for this purpose, since we have to
-   --  elaborate the initialization expression when it is first seen (i.e. this
-   --  elaboration cannot be deferred to the freeze point).
-
    procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
       Def_Id    : Entity_Id;
       Init_Call : Node_Id;
 
    begin
       Def_Id := Entity (Arg2 (N));
+
+      --  Variable case
+
       if Ekind (Def_Id) = E_Variable then
 
+         --  When applied to a variable, the default initialization must not be
+         --  done. As it is already done when the pragma is found, we just get
+         --  rid of the call the initialization procedure which followed the
+         --  object declaration. The call is inserted after the declaration,
+         --  but validity checks may also have been inserted and thus the
+         --  initialization call does not necessarily appear immediately
+         --  after the object declaration.
+
+         --  We can't use the freezing mechanism for this purpose, since we
+         --  have to elaborate the initialization expression when it is first
+         --  seen (so this elaboration cannot be deferred to the freeze point).
+
          --  Find and remove generated initialization call for object, if any
 
          Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
 
-         --  Any default initialization expression should be removed (e.g.,
+         --  Any default initialization expression should be removed (e.g.
          --  null defaults for access objects, zero initialization of packed
          --  bit arrays). Imported objects aren't allowed to have explicit
          --  initialization, so the expression must have been generated by
@@ -562,6 +579,71 @@ package body Exp_Prag is
          if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
             Set_Expression (Parent (Def_Id), Empty);
          end if;
+
+      --  Case of exception with convention C++
+
+      elsif Ekind (Def_Id) = E_Exception
+        and then Convention (Def_Id) = Convention_CPP
+      then
+         --  Import a C++ convention
+
+         declare
+            Loc          : constant Source_Ptr := Sloc (N);
+            Rtti_Name    : constant Node_Id    := Arg3 (N);
+            Dum          : constant Entity_Id  := Make_Temporary (Loc, 'D');
+            Exdata       : List_Id;
+            Lang_Char    : Node_Id;
+            Foreign_Data : Node_Id;
+
+         begin
+            Exdata := Component_Associations (Expression (Parent (Def_Id)));
+
+            Lang_Char := Next (First (Exdata));
+
+            --  Change the one-character language designator to 'C'
+
+            Rewrite (Expression (Lang_Char),
+              Make_Character_Literal (Loc,
+                Chars              => Name_uC,
+                Char_Literal_Value => UI_From_Int (Character'Pos ('C'))));
+            Analyze (Expression (Lang_Char));
+
+            --  Change the value of Foreign_Data
+
+            Foreign_Data := Next (Next (Next (Next (Lang_Char))));
+
+            Insert_Actions (Def_Id, New_List (
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Dum,
+                Object_Definition   =>
+                  New_Occurrence_Of (Standard_Character, Loc)),
+
+              Make_Pragma (Loc,
+                Chars                        => Name_Import,
+                Pragma_Argument_Associations => New_List (
+                  Make_Pragma_Argument_Association (Loc,
+                    Expression => Make_Identifier (Loc, Name_Ada)),
+
+                  Make_Pragma_Argument_Association (Loc,
+                    Expression => Make_Identifier (Loc, Chars (Dum))),
+
+                  Make_Pragma_Argument_Association (Loc,
+                    Chars => Name_External_Name,
+                    Expression => Relocate_Node (Rtti_Name))))));
+
+            Rewrite (Expression (Foreign_Data),
+              Unchecked_Convert_To (Standard_A_Char,
+                Make_Attribute_Reference (Loc,
+                  Prefix         => Make_Identifier (Loc, Chars (Dum)),
+                  Attribute_Name => Name_Address)));
+            Analyze (Expression (Foreign_Data));
+         end;
+
+      --  No special expansion required for any other case
+
+      else
+         null;
+
       end if;
    end Expand_Pragma_Import_Or_Interface;
 
@@ -603,6 +685,8 @@ package body Exp_Prag is
                Code           : Node_Id;
 
             begin
+               --  Compute the symbol for the code of the condition
+
                if Present (Interface_Name (Id)) then
                   Excep_Image := Strval (Interface_Name (Id));
                else
@@ -626,23 +710,35 @@ package body Exp_Prag is
                   Analyze (Expression (Lang_Char));
 
                   if Exception_Code (Id) /= No_Uint then
+
+                     --  The code for the exception is present. Create a linker
+                     --  alias to define the symbol.
+
                      Code :=
-                       Make_Integer_Literal (Loc,
-                         Intval => Exception_Code (Id));
+                       Unchecked_Convert_To (RTE (RE_Address),
+                         Make_Integer_Literal (Loc,
+                           Intval => Exception_Code (Id)));
+
+                     --  Declare a dummy object
 
                      Excep_Object :=
                        Make_Object_Declaration (Loc,
                          Defining_Identifier => Excep_Internal,
                          Object_Definition   =>
-                           New_Reference_To (RTE (RE_Exception_Code), Loc));
+                           New_Reference_To (RTE (RE_Address), Loc));
 
                      Insert_Action (N, Excep_Object);
                      Analyze (Excep_Object);
 
+                     --  Clear severity bits
+
                      Start_String;
                      Store_String_Int
                        (UI_To_Int (Exception_Code (Id)) / 8 * 8);
 
+                     --  Insert a pragma Linker_Alias to set the value of the
+                     --  dummy object symbol.
+
                      Excep_Alias :=
                        Make_Pragma (Loc,
                          Chars                        => Name_Linker_Alias,
@@ -658,6 +754,9 @@ package body Exp_Prag is
                      Insert_Action (N, Excep_Alias);
                      Analyze (Excep_Alias);
 
+                     --  Insert a pragma Export to give a Linker_Name to the
+                     --  dummy object.
+
                      Export_Pragma :=
                        Make_Pragma (Loc,
                          Chars                        => Name_Export,
@@ -682,15 +781,16 @@ package body Exp_Prag is
 
                   else
                      Code :=
-                        Unchecked_Convert_To (RTE (RE_Exception_Code),
-                          Make_Function_Call (Loc,
-                            Name =>
-                              New_Reference_To (RTE (RE_Import_Value), Loc),
-                            Parameter_Associations => New_List
-                              (Make_String_Literal (Loc,
-                                Strval => Excep_Image))));
+                        Make_Function_Call (Loc,
+                          Name                   =>
+                            New_Reference_To (RTE (RE_Import_Address), Loc),
+                          Parameter_Associations => New_List
+                            (Make_String_Literal (Loc,
+                              Strval => Excep_Image)));
                   end if;
 
+                  --  Generate the call to Register_VMS_Exception
+
                   Rewrite (Call,
                     Make_Procedure_Call_Statement (Loc,
                       Name => New_Reference_To
@@ -702,7 +802,7 @@ package body Exp_Prag is
                             Prefix         => New_Occurrence_Of (Id, Loc),
                             Attribute_Name => Name_Unrestricted_Access)))));
 
-                  Analyze_And_Resolve (Code, RTE (RE_Exception_Code));
+                  Analyze_And_Resolve (Code, RTE (RE_Address));
                   Analyze (Call);
                end if;