Skip to content

R
riscv-gcc-1
Commit f46faa08 by Arnaud Charlet
Options

[multiple changes] 

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).

From-SVN: r177387
parent 2ba7e31e
Showing with 145 additions and 274 deletions
gcc/ada/ChangeLog
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> 2011-08-04 Yannick Moy <moy@adacore.com>
* sem_prag.adb, sem.ads: Code cleanup. * sem_prag.adb, sem.ads: Code cleanup.
......
gcc/ada/exp_ch3.adb
...@@ -5022,27 +5022,6 @@ package body Exp_Ch3 is ...@@ -5022,27 +5022,6 @@ package body Exp_Ch3 is
Set_Homonym (Defining_Identifier (N), Homonym (Def_Id)); Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
Exchange_Entities (Defining_Identifier (N), Def_Id); Exchange_Entities (Defining_Identifier (N), Def_Id);
end; 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; end if;
return; return;
...@@ -6170,6 +6149,9 @@ package body Exp_Ch3 is ...@@ -6170,6 +6149,9 @@ package body Exp_Ch3 is
if not Building_Static_DT (Def_Id) then if not Building_Static_DT (Def_Id) then
Append_Freeze_Actions (Def_Id, Make_DT (Def_Id)); Append_Freeze_Actions (Def_Id, Make_DT (Def_Id));
end if; end if;
elsif VM_Target /= No_VM then
Append_Freeze_Actions (Def_Id, Make_VM_TSD (Def_Id));
end if; end if;
-- If the type has unknown discriminants, propagate dispatching -- If the type has unknown discriminants, propagate dispatching
......
gcc/ada/exp_ch4.adb
...@@ -629,14 +629,10 @@ package body Exp_Ch4 is ...@@ -629,14 +629,10 @@ package body Exp_Ch4 is
(Ref : Node_Id; (Ref : Node_Id;
Built_In_Place : Boolean := False) Built_In_Place : Boolean := False)
is is
Ref_Node : Node_Id; New_Node : Node_Id;
begin 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 if Ada_Version >= Ada_2005
and then Tagged_Type_Expansion
and then Is_Class_Wide_Type (DesigT) and then Is_Class_Wide_Type (DesigT)
and then not Scope_Suppress (Accessibility_Check) and then not Scope_Suppress (Accessibility_Check)
and then and then
...@@ -652,20 +648,37 @@ package body Exp_Ch4 is ...@@ -652,20 +648,37 @@ package body Exp_Ch4 is
-- address of the allocated object. -- address of the allocated object.
if Built_In_Place then if Built_In_Place then
Ref_Node := New_Copy (Ref); New_Node := New_Copy (Ref);
else 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; end if;
Insert_Action (N, Insert_Action (N,
Make_Raise_Program_Error (Loc, Make_Raise_Program_Error (Loc,
Condition => Condition =>
Make_Op_Gt (Loc, Make_Op_Gt (Loc,
Left_Opnd => Left_Opnd => New_Node,
Build_Get_Access_Level (Loc,
Make_Attribute_Reference (Loc,
Prefix => Ref_Node,
Attribute_Name => Name_Tag)),
Right_Opnd => Right_Opnd =>
Make_Integer_Literal (Loc, Type_Access_Level (PtrT))), Make_Integer_Literal (Loc, Type_Access_Level (PtrT))),
Reason => PE_Accessibility_Check_Failed)); Reason => PE_Accessibility_Check_Failed));
...@@ -2594,6 +2607,8 @@ package body Exp_Ch4 is ...@@ -2594,6 +2607,8 @@ package body Exp_Ch4 is
Clen : Node_Id; Clen : Node_Id;
Set : Boolean; Set : Boolean;
-- Start of processing for Expand_Concatenate
begin begin
-- Choose an appropriate computational type -- Choose an appropriate computational type
......
gcc/ada/exp_ch6.adb
...@@ -5382,21 +5382,6 @@ package body Exp_Ch6 is ...@@ -5382,21 +5382,6 @@ package body Exp_Ch6 is
-- Start of processing for Expand_N_Subprogram_Body -- Start of processing for Expand_N_Subprogram_Body
begin 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 -- 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 -- of statements if no declarations are present. This is used to insert
-- new stuff at the start. -- new stuff at the start.
......
gcc/ada/exp_ch7.adb
...@@ -1261,7 +1261,7 @@ package body Exp_Ch7 is ...@@ -1261,7 +1261,7 @@ package body Exp_Ch7 is
-- objects that need finalization. When flag Preprocess is set, the -- objects that need finalization. When flag Preprocess is set, the
-- routine will simply count the total number of controlled objects in -- routine will simply count the total number of controlled objects in
-- Decls. Flag Top_Level denotes whether the processing is done for -- 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 procedure Process_Object_Declaration
(Decl : Node_Id; (Decl : Node_Id;
...@@ -3810,24 +3810,10 @@ package body Exp_Ch7 is ...@@ -3810,24 +3810,10 @@ package body Exp_Ch7 is
-- Build dispatch tables of library level tagged types -- Build dispatch tables of library level tagged types
if Is_Library_Level_Entity (Spec_Ent) then if Tagged_Type_Expansion
if Tagged_Type_Expansion then and then Is_Library_Level_Entity (Spec_Ent)
Build_Static_Dispatch_Tables (N); 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;
end if; end if;
Build_Task_Activation_Call (N); Build_Task_Activation_Call (N);
...@@ -3948,42 +3934,12 @@ package body Exp_Ch7 is ...@@ -3948,42 +3934,12 @@ package body Exp_Ch7 is
-- Build dispatch tables of library level tagged types -- Build dispatch tables of library level tagged types
if Is_Compilation_Unit (Id) if Tagged_Type_Expansion
or else (Is_Generic_Instance (Id) and then (Is_Compilation_Unit (Id)
and then Is_Library_Level_Entity (Id)) or else (Is_Generic_Instance (Id)
and then Is_Library_Level_Entity (Id)))
then then
if Tagged_Type_Expansion then Build_Static_Dispatch_Tables (N);
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;
end if; end if;
-- Note: it is not necessary to worry about generating a subprogram -- Note: it is not necessary to worry about generating a subprogram
......
gcc/ada/exp_disp.adb
...@@ -61,6 +61,7 @@ with Snames; use Snames; ...@@ -61,6 +61,7 @@ with Snames; use Snames;
with Stand; use Stand; with Stand; use Stand;
with Stringt; use Stringt; with Stringt; use Stringt;
with SCIL_LL; use SCIL_LL; with SCIL_LL; use SCIL_LL;
with Targparm; use Targparm;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -82,10 +83,6 @@ package body Exp_Disp is ...@@ -82,10 +83,6 @@ package body Exp_Disp is
-- Returns true if Prim is not a predefined dispatching primitive but it 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) -- 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; function New_Value (From : Node_Id) return Node_Id;
-- From is the original Expression. New_Value is equivalent to a call -- From is the original Expression. New_Value is equivalent to a call
-- to Duplicate_Subexpr with an explicit dereference when From is an -- to Duplicate_Subexpr with an explicit dereference when From is an
...@@ -298,6 +295,7 @@ package body Exp_Disp is ...@@ -298,6 +295,7 @@ package body Exp_Disp is
return Static_Dispatch_Tables return Static_Dispatch_Tables
and then Is_Library_Level_Tagged_Type (Typ) 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 -- If the type is derived from a CPP class we cannot statically
-- build the dispatch tables because we must inherit primitives -- build the dispatch tables because we must inherit primitives
...@@ -468,156 +466,6 @@ package body Exp_Disp is ...@@ -468,156 +466,6 @@ package body Exp_Disp is
end if; end if;
end Build_Static_Dispatch_Tables; 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 -- -- Convert_Tag_To_Interface --
------------------------------ ------------------------------
...@@ -1278,11 +1126,37 @@ package body Exp_Disp is ...@@ -1278,11 +1126,37 @@ package body Exp_Disp is
and then Is_Interface (Iface_Typ))); and then Is_Interface (Iface_Typ)));
if not Tagged_Type_Expansion then 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; return;
end if; end if;
...@@ -6764,13 +6638,20 @@ package body Exp_Disp is ...@@ -6764,13 +6638,20 @@ package body Exp_Disp is
-- Check_TSD -- Check_TSD
-- (TSD => TSD'Unrestricted_Access); -- (TSD => TSD'Unrestricted_Access);
Append_To (Result, if Ada_Version >= Ada_2005
Make_Procedure_Call_Statement (Loc, and then Is_Library_Level_Entity (Typ)
Name => New_Reference_To (RTE (RE_Check_TSD), Loc), and then Has_External_Tag_Rep_Clause (Typ)
Parameter_Associations => New_List ( and then RTE_Available (RE_Check_TSD)
Make_Attribute_Reference (Loc, and then not Debug_Flag_QQ
Prefix => New_Reference_To (TSD, Loc), then
Attribute_Name => Name_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))));
end if;
-- Generate: -- Generate:
-- Register_TSD (TSD'Unrestricted_Access); -- Register_TSD (TSD'Unrestricted_Access);
...@@ -7653,6 +7534,7 @@ package body Exp_Disp is ...@@ -7653,6 +7534,7 @@ package body Exp_Disp is
begin begin
pragma Assert (not Restriction_Active (No_Dispatching_Calls)); pragma Assert (not Restriction_Active (No_Dispatching_Calls));
pragma Assert (VM_Target = No_VM);
-- Do not register in the dispatch table eliminated primitives -- Do not register in the dispatch table eliminated primitives
......
gcc/ada/exp_disp.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- --
...@@ -186,11 +186,6 @@ package Exp_Disp is ...@@ -186,11 +186,6 @@ package Exp_Disp is
-- bodies they are added to the end of the list of declarations of the -- bodies they are added to the end of the list of declarations of the
-- package body. -- 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 function Convert_Tag_To_Interface
(Typ : Entity_Id; Expr : Node_Id) return Node_Id; (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
pragma Inline (Convert_Tag_To_Interface); pragma Inline (Convert_Tag_To_Interface);
...@@ -353,6 +348,10 @@ package Exp_Disp is ...@@ -353,6 +348,10 @@ package Exp_Disp is
-- tagged types this routine imports the forward declaration of the tag -- tagged types this routine imports the forward declaration of the tag
-- entity, that will be declared and exported by Make_DT. -- 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 function Register_Primitive
(Loc : Source_Ptr; (Loc : Source_Ptr;
Prim : Entity_Id) return List_Id; Prim : Entity_Id) return List_Id;
......
gcc/ada/gnatlink.adb
...@@ -1717,7 +1717,7 @@ begin ...@@ -1717,7 +1717,7 @@ begin
Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("dotnet-ld"); Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("dotnet-ld");
if Linker_Path = null then if Linker_Path = null then
Exit_With_Error ("Couldn't locate ilasm"); Exit_With_Error ("Couldn't locate dotnet-ld");
end if; end if;
elsif RTX_RTSS_Kernel_Module_On_Target then elsif RTX_RTSS_Kernel_Module_On_Target then
......
gcc/ada/rtsfind.ads
...@@ -561,6 +561,7 @@ package Rtsfind is ...@@ -561,6 +561,7 @@ package Rtsfind is
RE_Address_Array, -- Ada.Tags RE_Address_Array, -- Ada.Tags
RE_Addr_Ptr, -- Ada.Tags RE_Addr_Ptr, -- Ada.Tags
RE_Base_Address, -- Ada.Tags RE_Base_Address, -- Ada.Tags
RE_Check_Interface_Conversion, -- Ada.Tags
RE_Check_TSD, -- Ada.Tags RE_Check_TSD, -- Ada.Tags
RE_Cstring_Ptr, -- Ada.Tags RE_Cstring_Ptr, -- Ada.Tags
RE_Descendant_Tag, -- Ada.Tags RE_Descendant_Tag, -- Ada.Tags
...@@ -1743,6 +1744,7 @@ package Rtsfind is ...@@ -1743,6 +1744,7 @@ package Rtsfind is
RE_Address_Array => Ada_Tags, RE_Address_Array => Ada_Tags,
RE_Addr_Ptr => Ada_Tags, RE_Addr_Ptr => Ada_Tags,
RE_Base_Address => Ada_Tags, RE_Base_Address => Ada_Tags,
RE_Check_Interface_Conversion => Ada_Tags,
RE_Check_TSD => Ada_Tags, RE_Check_TSD => Ada_Tags,
RE_Cstring_Ptr => Ada_Tags, RE_Cstring_Ptr => Ada_Tags,
RE_Descendant_Tag => Ada_Tags, RE_Descendant_Tag => Ada_Tags,
......
gcc/ada/sem_ch6.adb
...@@ -2849,7 +2849,8 @@ package body Sem_Ch6 is ...@@ -2849,7 +2849,8 @@ package body Sem_Ch6 is
-- raises an exception, but in any case it is not coming -- raises an exception, but in any case it is not coming
-- back here, so turn on the flag. -- 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) and then No_Return (Ent)
then then
Set_Trivial_Subprogram (Stm); Set_Trivial_Subprogram (Stm);
......
gcc/ada/sem_disp.adb
...@@ -49,6 +49,7 @@ with Sem_Type; use Sem_Type; ...@@ -49,6 +49,7 @@ with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
with Snames; use Snames; with Snames; use Snames;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Targparm; use Targparm;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -1028,6 +1029,12 @@ package body Sem_Disp is ...@@ -1028,6 +1029,12 @@ package body Sem_Disp is
" the type!", Subp); " the type!", Subp);
end if; end if;
-- No code required to register primitives in VM
-- targets
elsif VM_Target /= No_VM then
null;
else else
Insert_Actions_After (Subp_Body, Insert_Actions_After (Subp_Body,
Register_Primitive (Sloc (Subp_Body), Register_Primitive (Sloc (Subp_Body),
...@@ -1158,10 +1165,13 @@ package body Sem_Disp is ...@@ -1158,10 +1165,13 @@ package body Sem_Disp is
while Present (Elmt) loop while Present (Elmt) loop
Prim := Node (Elmt); Prim := Node (Elmt);
-- No code required to register primitives in VM targets
if Present (Alias (Prim)) if Present (Alias (Prim))
and then Present (Interface_Alias (Prim)) and then Present (Interface_Alias (Prim))
and then Alias (Prim) = Subp and then Alias (Prim) = Subp
and then not Building_Static_DT (Tagged_Type) and then not Building_Static_DT (Tagged_Type)
and then VM_Target = No_VM
then then
Insert_Actions_After (Subp_Body, Insert_Actions_After (Subp_Body,
Register_Primitive (Sloc (Subp_Body), Prim => Prim)); Register_Primitive (Sloc (Subp_Body), Prim => Prim));
......
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