2011-08-04 Javier Miranda <miranda@adacore.com>

	* exp_ch7.adb (Expand_N_Package_Body, Expand_N_Package_Declaration):
	Remove code which takes care of building TSDs.
	* rtsfind.ads (RE_Check_Interface_Conversion): New entity.
	* exp_ch4.adb (Apply_Accessibility_Check): Add support for generating
	the accessibility check in VM targets.
	* exp_disp.adb (Make_VM_TSD): Spec moved to exp_disp.ads
	(Building_Static_DT): Now returns false for VM targets.
	(Build_VM_TSDs): Removed.
	(Expand_Interface_Conversion): Generate missing runtime check for
	conversions to interface types whose target type is unknown at compile
	time.
	(Make_VM_TSD): Add missing code to disable the generation of calls to
	Check_TSD if the tagged type is not defined at library level, or not
	has a representation clause specifying its external tag, or -gnatdQ is
	active.
	* exp_disp.ads (Build_VM_TSDs): Removed.
	(Make_VM_TSDs): Spec relocated from exp_disp.adb
	* sem_disp.adb (Check_Dispatching_Operation): No code required to
	register primitives in the dispatch tables in VM targets.
	* exp_ch3.adb (Expand_N_Object_Declaration): Remove wrong expansion of
	initialization of class-wide interface objects in VM targets.
	(Expand_Freeze_Record_Type): For VM targets call Make_VM_TSD (instead
	of Make_DT).

2011-08-04  Jerome Lambourg  <lambourg@adacore.com>

	* gnatlink.adb (Gnatlink): Correct missleading error message displayed
	when dotnet-ld cannot be found.

2011-08-04  Arnaud Charlet  <charlet@adacore.com>

	* bindgen.adb: Simplify significantly generation of binder body file in
	CodePeer mode.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Prevent assert failure
	when compiling binder generated file in CodePeer mode (xxx'Elab_Spec
	not expanded).



git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@177387 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed, 279 insertions, 354 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ec696b94f1b..9e1dd4078a0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+2011-08-04  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch7.adb (Expand_N_Package_Body, Expand_N_Package_Declaration):
+	Remove code which takes care of building TSDs.
+	* rtsfind.ads (RE_Check_Interface_Conversion): New entity.
+	* exp_ch4.adb (Apply_Accessibility_Check): Add support for generating
+	the accessibility check in VM targets.
+	* exp_disp.adb (Make_VM_TSD): Spec moved to exp_disp.ads
+	(Building_Static_DT): Now returns false for VM targets.
+	(Build_VM_TSDs): Removed.
+	(Expand_Interface_Conversion): Generate missing runtime check for
+	conversions to interface types whose target type is unknown at compile
+	time.
+	(Make_VM_TSD): Add missing code to disable the generation of calls to
+	Check_TSD if the tagged type is not defined at library level, or not
+	has a representation clause specifying its external tag, or -gnatdQ is
+	active.
+	* exp_disp.ads (Build_VM_TSDs): Removed.
+	(Make_VM_TSDs): Spec relocated from exp_disp.adb
+	* sem_disp.adb (Check_Dispatching_Operation): No code required to
+	register primitives in the dispatch tables in VM targets.
+	* exp_ch3.adb (Expand_N_Object_Declaration): Remove wrong expansion of
+	initialization of class-wide interface objects in VM targets.
+	(Expand_Freeze_Record_Type): For VM targets call Make_VM_TSD (instead
+	of Make_DT).
+
+2011-08-04  Jerome Lambourg  <lambourg@adacore.com>
+
+	* gnatlink.adb (Gnatlink): Correct missleading error message displayed
+	when dotnet-ld cannot be found.
+
+2011-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+	* bindgen.adb: Simplify significantly generation of binder body file in
+	CodePeer mode.
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Prevent assert failure
+	when compiling binder generated file in CodePeer mode (xxx'Elab_Spec
+	not expanded).
+
 2011-08-04  Yannick Moy  <moy@adacore.com>
 
 	* sem_prag.adb, sem.ads: Code cleanup.
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index f2714cdd895..47e1d1b7f8f 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -435,7 +435,10 @@ package body Bindgen is
    begin
       WBI ("   procedure " & Ada_Final_Name.all & " is");
 
-      if VM_Target = No_VM and then Bind_Main_Program then
+      if VM_Target = No_VM
+        and Bind_Main_Program
+        and not CodePeer_Mode
+      then
          WBI ("      procedure s_stalib_adafinal;");
          Set_String ("      pragma Import (C, s_stalib_adafinal, ");
          Set_String ("""system__standard_library__adafinal"");");
@@ -443,15 +446,18 @@ package body Bindgen is
       end if;
 
       WBI ("   begin");
-      WBI ("      if not Is_Elaborated then");
-      WBI ("         return;");
-      WBI ("      end if;");
-      WBI ("      Is_Elaborated := False;");
+
+      if not CodePeer_Mode then
+         WBI ("      if not Is_Elaborated then");
+         WBI ("         return;");
+         WBI ("      end if;");
+         WBI ("      Is_Elaborated := False;");
+      end if;
 
       --  On non-virtual machine targets, finalization is done differently
       --  depending on whether this is the main program or a library.
 
-      if VM_Target = No_VM then
+      if VM_Target = No_VM and then not CodePeer_Mode then
          if Bind_Main_Program then
             WBI ("      s_stalib_adafinal;");
          elsif Lib_Final_Built then
@@ -462,6 +468,7 @@ package body Bindgen is
 
       --  Pragma Import C cannot be used on virtual machine targets, therefore
       --  call the runtime finalization routine directly.
+      --  Similarly in CodePeer mode, where imported functions are ignored.
 
       else
          WBI ("      System.Standard_Library.Adafinal;");
@@ -516,6 +523,7 @@ package body Bindgen is
 
       if not Suppress_Standard_Library_On_Target
         and then VM_Target = No_VM
+        and then not CodePeer_Mode
         and then not Configurable_Run_Time_On_Target
       then
          WBI ("   type No_Param_Proc is access procedure;");
@@ -524,11 +532,17 @@ package body Bindgen is
 
       WBI ("   procedure " & Ada_Init_Name.all & " is");
 
+      --  In CodePeer mode, simplify adainit procedure by only calling
+      --  elaboration procedures.
+
+      if CodePeer_Mode then
+         WBI ("   begin");
+
       --  If the standard library is suppressed, then the only global variables
       --  that might be needed (by the Ravenscar profile) are the priority and
       --  the processor for the environment task.
 
-      if Suppress_Standard_Library_On_Target then
+      elsif Suppress_Standard_Library_On_Target then
          if Main_Priority /= No_Main_Priority then
             WBI ("      Main_Priority : Integer;");
             WBI ("      pragma Import (C, Main_Priority," &
@@ -717,7 +731,6 @@ package body Bindgen is
          end if;
 
          WBI ("   begin");
-
          WBI ("      if Is_Elaborated then");
          WBI ("         return;");
          WBI ("      end if;");
@@ -904,12 +917,17 @@ package body Bindgen is
          WBI ("      Initialize_Stack_Limit;");
       end if;
 
+      --  On CodePeer, the finalization of library objects is not relevant
+
+      if CodePeer_Mode then
+         null;
+
       --  On virtual machine targets, or on non-virtual machine ones if this
       --  is the main program case, attach finalize_library to the soft link.
       --  Do it only when not using a restricted run time, in which case tasks
       --  are non-terminating, so we do not want library-level finalization.
 
-      if (VM_Target /= No_VM or else Bind_Main_Program)
+      elsif (VM_Target /= No_VM or else Bind_Main_Program)
         and then not Configurable_Run_Time_On_Target
         and then not Suppress_Standard_Library_On_Target
       then
@@ -942,7 +960,10 @@ package body Bindgen is
 
       --  Generate elaboration calls
 
-      WBI ("");
+      if not CodePeer_Mode then
+         WBI ("");
+      end if;
+
       Gen_Elab_Calls_Ada;
 
       --  Case of main program is CIL function or procedure
@@ -1257,6 +1278,10 @@ package body Bindgen is
 
    procedure Gen_Elab_Externals_Ada is
    begin
+      if CodePeer_Mode then
+         return;
+      end if;
+
       for E in Elab_Order.First .. Elab_Order.Last loop
          declare
             Unum : constant Unit_Id := Elab_Order.Table (E);
@@ -1380,6 +1405,7 @@ package body Bindgen is
    ------------------------
 
    procedure Gen_Elab_Calls_Ada is
+      Check_Elab_Flag : Boolean;
    begin
       for E in Elab_Order.First .. Elab_Order.Last loop
          declare
@@ -1420,6 +1446,7 @@ package body Bindgen is
 
                if U.Utype = Is_Body
                  and then Units.Table (Unum_Spec).Set_Elab_Entity
+                 and then not CodePeer_Mode
                then
                   Set_String ("      E");
                   Set_Unit_Number (Unum_Spec);
@@ -1449,10 +1476,13 @@ package body Bindgen is
             --  elaboration subprogram is needed by CodePeer.
 
             elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then
-               if Force_Checking_Of_Elaboration_Flags
-                 or Interface_Library_Unit
-                 or not Bind_Main_Program
-               then
+               Check_Elab_Flag :=
+                 not CodePeer_Mode
+                 and then (Force_Checking_Of_Elaboration_Flags
+                            or Interface_Library_Unit
+                            or not Bind_Main_Program);
+
+               if Check_Elab_Flag then
                   Set_String ("      if E");
                   Set_Unit_Number (Unum_Spec);
                   Set_String (" = 0 then");
@@ -1491,14 +1521,13 @@ package body Bindgen is
                Set_Char (';');
                Write_Statement_Buffer;
 
-               if Force_Checking_Of_Elaboration_Flags
-                 or Interface_Library_Unit
-                 or not Bind_Main_Program
-               then
+               if Check_Elab_Flag then
                   WBI ("      end if;");
                end if;
 
-               if U.Utype /= Is_Spec then
+               if U.Utype /= Is_Spec
+                 and then not CodePeer_Mode
+               then
                   Set_String ("      E");
                   Set_Unit_Number (Unum_Spec);
                   Set_String (" := E");
@@ -1717,6 +1746,10 @@ package body Bindgen is
    --  Start of processing for Gen_Finalize_Library_Ada
 
    begin
+      if CodePeer_Mode then
+         return;
+      end if;
+
       for E in reverse Elab_Order.First .. Elab_Order.Last loop
          Unum := Elab_Order.Table (E);
          U    := Units.Table (Unum);
@@ -2211,7 +2244,9 @@ package body Bindgen is
 
       --  Initialize and Finalize
 
-      if not Cumulative_Restrictions.Set (No_Finalization) then
+      if not CodePeer_Mode
+        and then not Cumulative_Restrictions.Set (No_Finalization)
+      then
          WBI ("      procedure Initialize (Addr : System.Address);");
          WBI ("      pragma Import (C, Initialize, ""__gnat_initialize"");");
          WBI ("");
@@ -2238,44 +2273,50 @@ package body Bindgen is
       --  Deal with declarations for main program case
 
       if not No_Main_Subprogram then
+         if CodePeer_Mode then
+            if ALIs.Table (ALIs.First).Main_Program = Func then
+               WBI ("      Result : Integer;");
+            end if;
+         else
+            --  To call the main program, we declare it using a pragma Import
+            --  Ada with the right link name.
 
-         --  To call the main program, we declare it using a pragma Import
-         --  Ada with the right link name.
-
-         --  It might seem more obvious to "with" the main program, and call
-         --  it in the normal Ada manner. We do not do this for three reasons:
-
-         --    1. It is more efficient not to recompile the main program
-         --    2. We are not entitled to assume the source is accessible
-         --    3. We don't know what options to use to compile it
+            --  It might seem more obvious to "with" the main program, and call
+            --  it in the normal Ada manner. We do not do this for three
+            --  reasons:
 
-         --  It is really reason 3 that is most critical (indeed we used
-         --  to generate the "with", but several regression tests failed).
+            --    1. It is more efficient not to recompile the main program
+            --    2. We are not entitled to assume the source is accessible
+            --    3. We don't know what options to use to compile it
 
-         WBI ("");
+            --  It is really reason 3 that is most critical (indeed we used
+            --  to generate the "with", but several regression tests failed).
 
-         if ALIs.Table (ALIs.First).Main_Program = Func then
-            WBI ("      Result : Integer;");
             WBI ("");
-            WBI ("      function Ada_Main_Program return Integer;");
 
-         else
-            WBI ("      procedure Ada_Main_Program;");
-         end if;
+            if ALIs.Table (ALIs.First).Main_Program = Func then
+               WBI ("      Result : Integer;");
+               WBI ("");
+               WBI ("      function Ada_Main_Program return Integer;");
 
-         Set_String ("      pragma Import (Ada, Ada_Main_Program, """);
-         Get_Name_String (Units.Table (First_Unit_Entry).Uname);
-         Set_Main_Program_Name;
-         Set_String (""");");
+            else
+               WBI ("      procedure Ada_Main_Program;");
+            end if;
 
-         Write_Statement_Buffer;
-         WBI ("");
+            Set_String ("      pragma Import (Ada, Ada_Main_Program, """);
+            Get_Name_String (Units.Table (First_Unit_Entry).Uname);
+            Set_Main_Program_Name;
+            Set_String (""");");
 
-         if Bind_Main_Program
-           and then not Suppress_Standard_Library_On_Target
-         then
-            WBI ("      SEH : aliased array (1 .. 2) of Integer;");
+            Write_Statement_Buffer;
             WBI ("");
+
+            if Bind_Main_Program
+              and then not Suppress_Standard_Library_On_Target
+            then
+               WBI ("      SEH : aliased array (1 .. 2) of Integer;");
+               WBI ("");
+            end if;
          end if;
       end if;
 
@@ -2289,7 +2330,7 @@ package body Bindgen is
       --  with a pragma Volatile in order to tell the compiler to preserve
       --  this variable at any level of optimization.
 
-      if Bind_Main_Program then
+      if Bind_Main_Program and then not CodePeer_Mode then
          WBI
            ("      Ensure_Reference : aliased System.Address := " &
             "Ada_Main_Program_Name'Address;");
@@ -2301,7 +2342,10 @@ package body Bindgen is
 
       --  Acquire command line arguments if present on target
 
-      if Command_Line_Args_On_Target then
+      if CodePeer_Mode then
+         null;
+
+      elsif Command_Line_Args_On_Target then
          WBI ("      gnat_argc := argc;");
          WBI ("      gnat_argv := argv;");
          WBI ("      gnat_envp := envp;");
@@ -2339,7 +2383,9 @@ package body Bindgen is
          Write_Statement_Buffer;
       end if;
 
-      if not Cumulative_Restrictions.Set (No_Finalization) then
+      if not Cumulative_Restrictions.Set (No_Finalization)
+        and then not CodePeer_Mode
+      then
          if not No_Main_Subprogram
            and then Bind_Main_Program
            and then not Suppress_Standard_Library_On_Target
@@ -2383,7 +2429,9 @@ package body Bindgen is
 
       --  Finalize is only called if we have a run time
 
-      if not Cumulative_Restrictions.Set (No_Finalization) then
+      if not Cumulative_Restrictions.Set (No_Finalization)
+        and then not CodePeer_Mode
+      then
          WBI ("      Finalize;");
       end if;
 
@@ -2986,13 +3034,16 @@ package body Bindgen is
       Resolve_Binder_Options;
 
       --  Usually, adafinal is called using a pragma Import C. Since Import C
-      --  doesn't have the same semantics for JGNAT, we use standard Ada.
+      --  doesn't have the same semantics for VMs or CodePeer, use standard
+      --  Ada.
 
-      if VM_Target /= No_VM
-        and then not Suppress_Standard_Library_On_Target
-      then
-         WBI ("with System.Soft_Links;");
-         WBI ("with System.Standard_Library;");
+      if not Suppress_Standard_Library_On_Target then
+         if CodePeer_Mode then
+            WBI ("with System.Standard_Library;");
+         elsif VM_Target /= No_VM then
+            WBI ("with System.Soft_Links;");
+            WBI ("with System.Standard_Library;");
+         end if;
       end if;
 
       WBI ("package " & Ada_Main & " is");
@@ -3212,38 +3263,41 @@ package body Bindgen is
 
       Gen_Elab_Externals_Ada;
 
-      if not Suppress_Standard_Library_On_Target then
+      if not CodePeer_Mode then
+         if not Suppress_Standard_Library_On_Target then
 
-         --  Generate Priority_Specific_Dispatching pragma string
+            --  Generate Priority_Specific_Dispatching pragma string
 
-         Set_String
-           ("   Local_Priority_Specific_Dispatching : constant String := """);
+            Set_String
+              ("   Local_Priority_Specific_Dispatching : " &
+               "constant String := """);
 
-         for J in 0 .. PSD_Pragma_Settings.Last loop
-            Set_Char (PSD_Pragma_Settings.Table (J));
-         end loop;
+            for J in 0 .. PSD_Pragma_Settings.Last loop
+               Set_Char (PSD_Pragma_Settings.Table (J));
+            end loop;
 
-         Set_String (""";");
-         Write_Statement_Buffer;
+            Set_String (""";");
+            Write_Statement_Buffer;
 
-         --  Generate Interrupt_State pragma string
+            --  Generate Interrupt_State pragma string
 
-         Set_String ("   Local_Interrupt_States : constant String := """);
+            Set_String ("   Local_Interrupt_States : constant String := """);
 
-         for J in 0 .. IS_Pragma_Settings.Last loop
-            Set_Char (IS_Pragma_Settings.Table (J));
-         end loop;
+            for J in 0 .. IS_Pragma_Settings.Last loop
+               Set_Char (IS_Pragma_Settings.Table (J));
+            end loop;
 
-         Set_String (""";");
-         Write_Statement_Buffer;
-         WBI ("");
-      end if;
+            Set_String (""";");
+            Write_Statement_Buffer;
+            WBI ("");
+         end if;
 
-      --  The B.1 (39) implementation advice says that the adainit/adafinal
-      --  routines should be idempotent. Generate a flag to ensure that.
+         --  The B.1 (39) implementation advice says that the adainit/adafinal
+         --  routines should be idempotent. Generate a flag to ensure that.
 
-      WBI ("   Is_Elaborated : Boolean := False;");
-      WBI ("");
+         WBI ("   Is_Elaborated : Boolean := False;");
+         WBI ("");
+      end if;
 
       --  Generate the adafinal routine unless there is no finalization to do
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index a5038a992a6..eafb238a6ed 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5022,27 +5022,6 @@ package body Exp_Ch3 is
                   Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
                   Exchange_Entities (Defining_Identifier (N), Def_Id);
                end;
-
-            --  Handle initialization of class-wide interface object in VM
-            --  targets
-
-            elsif not Tagged_Type_Expansion then
-
-               --  Replace
-               --     CW : I'Class := Obj;
-               --  by
-               --     CW : I'Class;
-               --     CW := I'Class (Obj); [1]
-
-               --  The assignment [1] is later expanded in a dispatching
-               --  call to _assign
-
-               Set_Expression (N, Empty);
-
-               Insert_Action (N,
-                 Make_Assignment_Statement (Loc,
-                   Name       => New_Reference_To (Def_Id, Loc),
-                   Expression => Convert_To (Typ, Relocate_Node (Expr))));
             end if;
 
             return;
@@ -6170,6 +6149,9 @@ package body Exp_Ch3 is
                if not Building_Static_DT (Def_Id) then
                   Append_Freeze_Actions (Def_Id, Make_DT (Def_Id));
                end if;
+
+            elsif VM_Target /= No_VM then
+               Append_Freeze_Actions (Def_Id, Make_VM_TSD (Def_Id));
             end if;
 
             --  If the type has unknown discriminants, propagate dispatching
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d99157ab4d0..d2852e3dd80 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -629,14 +629,10 @@ package body Exp_Ch4 is
         (Ref            : Node_Id;
          Built_In_Place : Boolean := False)
       is
-         Ref_Node : Node_Id;
+         New_Node : Node_Id;
 
       begin
-         --  Note: we skip the accessibility check for the VM case, since
-         --  there does not seem to be any practical way of implementing it.
-
          if Ada_Version >= Ada_2005
-           and then Tagged_Type_Expansion
            and then Is_Class_Wide_Type (DesigT)
            and then not Scope_Suppress (Accessibility_Check)
            and then
@@ -652,20 +648,37 @@ package body Exp_Ch4 is
             --  address of the allocated object.
 
             if Built_In_Place then
-               Ref_Node := New_Copy (Ref);
+               New_Node := New_Copy (Ref);
             else
-               Ref_Node := New_Reference_To (Ref, Loc);
+               New_Node := New_Reference_To (Ref, Loc);
+            end if;
+
+            New_Node :=
+              Make_Attribute_Reference (Loc,
+                Prefix         => New_Node,
+                Attribute_Name => Name_Tag);
+
+            if Tagged_Type_Expansion then
+               New_Node :=
+                 Build_Get_Access_Level (Loc, New_Node);
+
+            elsif VM_Target /= No_VM then
+               New_Node :=
+                 Make_Function_Call (Loc,
+                   Name => New_Reference_To (RTE (RE_Get_Access_Level), Loc),
+                   Parameter_Associations => New_List (New_Node));
+
+            --  Cannot generate the runtime check
+
+            else
+               return;
             end if;
 
             Insert_Action (N,
               Make_Raise_Program_Error (Loc,
                 Condition =>
                   Make_Op_Gt (Loc,
-                    Left_Opnd  =>
-                      Build_Get_Access_Level (Loc,
-                        Make_Attribute_Reference (Loc,
-                          Prefix         => Ref_Node,
-                          Attribute_Name => Name_Tag)),
+                    Left_Opnd  => New_Node,
                     Right_Opnd =>
                       Make_Integer_Literal (Loc, Type_Access_Level (PtrT))),
                 Reason => PE_Accessibility_Check_Failed));
@@ -2594,6 +2607,8 @@ package body Exp_Ch4 is
       Clen     : Node_Id;
       Set      : Boolean;
 
+   --  Start of processing for Expand_Concatenate
+
    begin
       --  Choose an appropriate computational type
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index dfa5b3f9643..cb6a6543ca4 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5382,21 +5382,6 @@ package body Exp_Ch6 is
    --  Start of processing for Expand_N_Subprogram_Body
 
    begin
-      --  If this is the main compilation unit, and we are generating code for
-      --  VM targets, we now generate the Type Specific Data record of all the
-      --  enclosing tagged type declarations.
-
-      --  If the runtime package Ada_Tags has not been loaded then this
-      --  subprogram does not have tagged type declarations and there is no
-      --  need to search for tagged types to generate their TSDs.
-
-      if not Tagged_Type_Expansion
-        and then Unit (Cunit (Main_Unit)) = N
-        and then RTU_Loaded (Ada_Tags)
-      then
-         Build_VM_TSDs (N);
-      end if;
-
       --  Set L to either the list of declarations if present, or to the list
       --  of statements if no declarations are present. This is used to insert
       --  new stuff at the start.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 452b9e5b2e4..c31682caec7 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1261,7 +1261,7 @@ package body Exp_Ch7 is
       --  objects that need finalization. When flag Preprocess is set, the
       --  routine will simply count the total number of controlled objects in
       --  Decls. Flag Top_Level denotes whether the processing is done for
-      --  objects in nested package decparations or instances.
+      --  objects in nested package declarations or instances.
 
       procedure Process_Object_Declaration
         (Decl         : Node_Id;
@@ -3810,24 +3810,10 @@ package body Exp_Ch7 is
 
          --  Build dispatch tables of library level tagged types
 
-         if Is_Library_Level_Entity (Spec_Ent) then
-            if Tagged_Type_Expansion then
-               Build_Static_Dispatch_Tables (N);
-
-            --  In VM targets there is no need to build dispatch tables but
-            --  we must generate the corresponding Type Specific Data record.
-
-            elsif Unit (Cunit (Main_Unit)) = N then
-
-               --  If the runtime package Ada_Tags has not been loaded then
-               --  this package does not have tagged type declarations and
-               --  there is no need to search for tagged types to generate
-               --  their TSDs.
-
-               if RTU_Loaded (Ada_Tags) then
-                  Build_VM_TSDs (N);
-               end if;
-            end if;
+         if Tagged_Type_Expansion
+           and then Is_Library_Level_Entity (Spec_Ent)
+         then
+            Build_Static_Dispatch_Tables (N);
          end if;
 
          Build_Task_Activation_Call (N);
@@ -3948,42 +3934,12 @@ package body Exp_Ch7 is
 
       --  Build dispatch tables of library level tagged types
 
-      if Is_Compilation_Unit (Id)
-        or else (Is_Generic_Instance (Id)
-                  and then Is_Library_Level_Entity (Id))
+      if Tagged_Type_Expansion
+        and then (Is_Compilation_Unit (Id)
+                    or else (Is_Generic_Instance (Id)
+                               and then Is_Library_Level_Entity (Id)))
       then
-         if Tagged_Type_Expansion then
-            Build_Static_Dispatch_Tables (N);
-
-         --  In VM targets there is no need to build dispatch tables, but we
-         --  must generate the corresponding Type Specific Data record.
-
-         elsif Unit (Cunit (Main_Unit)) = N then
-
-            --  If the runtime package Ada_Tags has not been loaded then
-            --  this package does not have tagged types and there is no need
-            --  to search for tagged types to generate their TSDs.
-
-            if RTU_Loaded (Ada_Tags) then
-
-               --  Enter the scope of the package because the new declarations
-               --  are appended at the end of the package and must be analyzed
-               --  in that context.
-
-               Push_Scope (Id);
-
-               if Is_Generic_Instance (Main_Unit_Entity) then
-                  if Package_Instantiation (Main_Unit_Entity) = N then
-                     Build_VM_TSDs (N);
-                  end if;
-
-               else
-                  Build_VM_TSDs (N);
-               end if;
-
-               Pop_Scope;
-            end if;
-         end if;
+         Build_Static_Dispatch_Tables (N);
       end if;
 
       --  Note: it is not necessary to worry about generating a subprogram
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 4df6eff6021..a9ae2c55172 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -61,6 +61,7 @@ with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
 with SCIL_LL;  use SCIL_LL;
+with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 
@@ -82,10 +83,6 @@ package body Exp_Disp is
    --  Returns true if Prim is not a predefined dispatching primitive but it is
    --  an alias of a predefined dispatching primitive (i.e. through a renaming)
 
-   function Make_VM_TSD (Typ : Entity_Id) return List_Id;
-   --  Build the Type Specific Data record associated with tagged type Typ.
-   --  Invoked only when generating code for VM targets.
-
    function New_Value (From : Node_Id) return Node_Id;
    --  From is the original Expression. New_Value is equivalent to a call
    --  to Duplicate_Subexpr with an explicit dereference when From is an
@@ -298,6 +295,7 @@ package body Exp_Disp is
 
       return Static_Dispatch_Tables
         and then Is_Library_Level_Tagged_Type (Typ)
+        and then VM_Target = No_VM
 
          --  If the type is derived from a CPP class we cannot statically
          --  build the dispatch tables because we must inherit primitives
@@ -468,156 +466,6 @@ package body Exp_Disp is
       end if;
    end Build_Static_Dispatch_Tables;
 
-   -------------------
-   -- Build_VM_TSDs --
-   -------------------
-
-   procedure Build_VM_TSDs (N : Entity_Id) is
-      Target_List : List_Id := No_List;
-
-      procedure Build_TSDs (List : List_Id);
-      --  Build the static dispatch table of tagged types found in the list of
-      --  declarations. Add the generated nodes to the end of Target_List.
-
-      procedure Build_Package_TSDs (N : Node_Id);
-      --  Build static dispatch tables associated with package declaration N
-
-      ---------------------------
-      -- Build_Dispatch_Tables --
-      ---------------------------
-
-      procedure Build_TSDs (List : List_Id) is
-         D : Node_Id;
-
-      begin
-         D := First (List);
-         while Present (D) loop
-
-            --  Handle nested packages and package bodies recursively. The
-            --  generated code is placed on the Target_List established for
-            --  the enclosing compilation unit.
-
-            if Nkind (D) = N_Package_Declaration then
-               Build_Package_TSDs (D);
-
-            elsif Nkind_In (D, N_Package_Body,
-                               N_Subprogram_Body)
-            then
-               Build_TSDs (Declarations (D));
-
-            elsif Nkind (D) = N_Package_Body_Stub
-              and then Present (Library_Unit (D))
-            then
-               Build_TSDs
-                 (Declarations (Proper_Body (Unit (Library_Unit (D)))));
-
-            --  Handle full type declarations and derivations of library
-            --  level tagged types
-
-            elsif Nkind_In (D, N_Full_Type_Declaration,
-                               N_Derived_Type_Definition)
-              and then Ekind (Defining_Entity (D)) /= E_Record_Subtype
-              and then Is_Tagged_Type (Defining_Entity (D))
-              and then not Is_Private_Type (Defining_Entity (D))
-            then
-               --  Do not generate TSDs for the internal types created for
-               --  a type extension with unknown discriminants. The needed
-               --  information is shared with the source type.
-               --  See Expand_N_Record_Extension.
-
-               if Is_Underlying_Record_View (Defining_Entity (D))
-                 or else
-                  (not Comes_From_Source (Defining_Entity (D))
-                     and then
-                       Has_Unknown_Discriminants (Etype (Defining_Entity (D)))
-                     and then
-                       not Comes_From_Source
-                             (First_Subtype (Defining_Entity (D))))
-               then
-                  null;
-
-               else
-                  if No (Target_List) then
-                     Target_List := New_List;
-                  end if;
-
-                  Append_List_To (Target_List,
-                    Make_VM_TSD (Defining_Entity (D)));
-               end if;
-            end if;
-
-            Next (D);
-         end loop;
-      end Build_TSDs;
-
-      ------------------------
-      -- Build_Package_TSDs --
-      ------------------------
-
-      procedure Build_Package_TSDs (N : Node_Id) is
-         Spec       : constant Node_Id := Specification (N);
-         Vis_Decls  : constant List_Id := Visible_Declarations (Spec);
-         Priv_Decls : constant List_Id := Private_Declarations (Spec);
-
-      begin
-         if Present (Priv_Decls) then
-            Build_TSDs (Vis_Decls);
-            Build_TSDs (Priv_Decls);
-
-         elsif Present (Vis_Decls) then
-            Build_TSDs (Vis_Decls);
-         end if;
-      end Build_Package_TSDs;
-
-   --  Start of processing for Build_VM_TSDs
-
-   begin
-      if not Expander_Active
-        or else No_Run_Time_Mode
-        or else Tagged_Type_Expansion
-        or else not RTE_Available (RE_Type_Specific_Data)
-      then
-         return;
-      end if;
-
-      if Nkind (N) = N_Package_Declaration then
-         declare
-            Spec       : constant Node_Id := Specification (N);
-            Vis_Decls  : constant List_Id := Visible_Declarations (Spec);
-            Priv_Decls : constant List_Id := Private_Declarations (Spec);
-
-         begin
-            Build_Package_TSDs (N);
-
-            if Present (Target_List) then
-               Analyze_List (Target_List);
-
-               if Present (Priv_Decls)
-                 and then Is_Non_Empty_List (Priv_Decls)
-               then
-                  Append_List (Target_List, Priv_Decls);
-               else
-                  Append_List (Target_List, Vis_Decls);
-               end if;
-            end if;
-         end;
-
-      elsif Nkind_In (N, N_Package_Body, N_Subprogram_Body) then
-         if Is_Non_Empty_List (Declarations (N)) then
-            Build_TSDs (Declarations (N));
-
-            if Nkind (N) = N_Subprogram_Body then
-               Build_TSDs (Statements (Handled_Statement_Sequence (N)));
-            end if;
-
-            if Present (Target_List) then
-               Analyze_List (Target_List);
-               Append_List  (Target_List, Declarations (N));
-            end if;
-         end if;
-      end if;
-   end Build_VM_TSDs;
-
    ------------------------------
    -- Convert_Tag_To_Interface --
    ------------------------------
@@ -1278,11 +1126,37 @@ package body Exp_Disp is
                   and then Is_Interface (Iface_Typ)));
 
       if not Tagged_Type_Expansion then
+         if VM_Target /= No_VM then
+            if Is_Access_Type (Operand_Typ) then
+               Operand_Typ := Designated_Type (Operand_Typ);
+            end if;
 
-         --  For VM, just do a conversion ???
+            if Is_Class_Wide_Type (Operand_Typ) then
+               Operand_Typ := Root_Type (Operand_Typ);
+            end if;
+
+            if not Is_Static
+              and then Operand_Typ /= Iface_Typ
+            then
+               Insert_Action (N,
+                 Make_Procedure_Call_Statement (Loc,
+                   Name => New_Occurrence_Of
+                            (RTE (RE_Check_Interface_Conversion), Loc),
+                   Parameter_Associations => New_List (
+                     Make_Attribute_Reference (Loc,
+                       Prefix => Duplicate_Subexpr (Expression (N)),
+                       Attribute_Name => Name_Tag),
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => New_Reference_To (Iface_Typ, Loc),
+                       Attribute_Name => Name_Tag))));
+            end if;
+
+            --  Just do a conversion ???
+
+            Rewrite (N, Unchecked_Convert_To (Etype (N), N));
+            Analyze (N);
+         end if;
 
-         Rewrite (N, Unchecked_Convert_To (Etype (N), N));
-         Analyze (N);
          return;
       end if;
 
@@ -6764,13 +6638,20 @@ package body Exp_Disp is
       --     Check_TSD
       --       (TSD => TSD'Unrestricted_Access);
 
-      Append_To (Result,
-        Make_Procedure_Call_Statement (Loc,
-          Name => New_Reference_To (RTE (RE_Check_TSD), Loc),
-          Parameter_Associations => New_List (
-            Make_Attribute_Reference (Loc,
-              Prefix => New_Reference_To (TSD, Loc),
-              Attribute_Name => Name_Unrestricted_Access))));
+      if Ada_Version >= Ada_2005
+        and then Is_Library_Level_Entity (Typ)
+        and then Has_External_Tag_Rep_Clause (Typ)
+        and then RTE_Available (RE_Check_TSD)
+        and then not Debug_Flag_QQ
+      then
+         Append_To (Result,
+           Make_Procedure_Call_Statement (Loc,
+             Name => New_Reference_To (RTE (RE_Check_TSD), Loc),
+             Parameter_Associations => New_List (
+               Make_Attribute_Reference (Loc,
+                 Prefix => New_Reference_To (TSD, Loc),
+                 Attribute_Name => Name_Unrestricted_Access))));
+      end if;
 
       --  Generate:
       --     Register_TSD (TSD'Unrestricted_Access);
@@ -7653,6 +7534,7 @@ package body Exp_Disp is
 
    begin
       pragma Assert (not Restriction_Active (No_Dispatching_Calls));
+      pragma Assert (VM_Target = No_VM);
 
       --  Do not register in the dispatch table eliminated primitives
 
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index 82a9d9abc15..306cec228ef 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -186,11 +186,6 @@ package Exp_Disp is
    --  bodies they are added to the end of the list of declarations of the
    --  package body.
 
-   procedure Build_VM_TSDs (N : Entity_Id);
-   --  N is a library level package declaration, a library level package body
-   --  or a library level subprogram body. Build the runtime Type Specific
-   --  Data record of all the tagged types declared inside N.
-
    function Convert_Tag_To_Interface
      (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
    pragma Inline (Convert_Tag_To_Interface);
@@ -353,6 +348,10 @@ package Exp_Disp is
    --  tagged types this routine imports the forward declaration of the tag
    --  entity, that will be declared and exported by Make_DT.
 
+   function Make_VM_TSD (Typ : Entity_Id) return List_Id;
+   --  Build the Type Specific Data record associated with tagged type Typ.
+   --  Invoked only when generating code for VM targets.
+
    function Register_Primitive
      (Loc     : Source_Ptr;
       Prim    : Entity_Id) return List_Id;
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index c2e2de74f49..946c7b54177 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -1717,7 +1717,7 @@ begin
          Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("dotnet-ld");
 
          if Linker_Path = null then
-            Exit_With_Error ("Couldn't locate ilasm");
+            Exit_With_Error ("Couldn't locate dotnet-ld");
          end if;
 
       elsif RTX_RTSS_Kernel_Module_On_Target then
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 1d545dfe596..d60de40b643 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -561,6 +561,7 @@ package Rtsfind is
      RE_Address_Array,                   -- Ada.Tags
      RE_Addr_Ptr,                        -- Ada.Tags
      RE_Base_Address,                    -- Ada.Tags
+     RE_Check_Interface_Conversion,      -- Ada.Tags
      RE_Check_TSD,                       -- Ada.Tags
      RE_Cstring_Ptr,                     -- Ada.Tags
      RE_Descendant_Tag,                  -- Ada.Tags
@@ -1743,6 +1744,7 @@ package Rtsfind is
      RE_Address_Array                    => Ada_Tags,
      RE_Addr_Ptr                         => Ada_Tags,
      RE_Base_Address                     => Ada_Tags,
+     RE_Check_Interface_Conversion       => Ada_Tags,
      RE_Check_TSD                        => Ada_Tags,
      RE_Cstring_Ptr                      => Ada_Tags,
      RE_Descendant_Tag                   => Ada_Tags,
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 98b6d91c4ff..986a1e867f2 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2849,7 +2849,8 @@ package body Sem_Ch6 is
                      --  raises an exception, but in any case it is not coming
                      --  back here, so turn on the flag.
 
-                     if Ekind (Ent) = E_Procedure
+                     if Present (Ent)
+                       and then Ekind (Ent) = E_Procedure
                        and then No_Return (Ent)
                      then
                         Set_Trivial_Subprogram (Stm);
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index b58f8c0e1a7..66fcb07e0ab 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -49,6 +49,7 @@ with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;
 with Snames;   use Snames;
 with Sinfo;    use Sinfo;
+with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 
@@ -1028,6 +1029,12 @@ package body Sem_Disp is
                                     " the type!", Subp);
                               end if;
 
+                           --  No code required to register primitives in VM
+                           --  targets
+
+                           elsif VM_Target /= No_VM then
+                              null;
+
                            else
                               Insert_Actions_After (Subp_Body,
                                 Register_Primitive (Sloc (Subp_Body),
@@ -1158,10 +1165,13 @@ package body Sem_Disp is
                   while Present (Elmt) loop
                      Prim := Node (Elmt);
 
+                     --  No code required to register primitives in VM targets
+
                      if Present (Alias (Prim))
                        and then Present (Interface_Alias (Prim))
                        and then Alias (Prim) = Subp
                        and then not Building_Static_DT (Tagged_Type)
+                       and then VM_Target = No_VM
                      then
                         Insert_Actions_After (Subp_Body,
                           Register_Primitive (Sloc (Subp_Body), Prim => Prim));