mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 13:51:00 +08:00
Code Issues Packages Projects Releases Wiki Activity

a-tags.ads, a-tags.adb (Displace): Associate a message with the raised CE exception.

Browse Source 
2007-08-14  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads, 
	a-tags.adb (Displace): Associate a message with the raised CE
	exception.
	(To_Addr_Ptr, To_Address, To_Dispatch_Table_Ptr,
	To_Object_Specific_Data_Ptr To_Predef_Prims_Ptr,
	To_Tag_Ptr, To_Type_Specific_Data_Ptr): Moved here from the package
	spec.
	(Default_Prim_Op_Count): Removed.
	(IW_Membership, Get_Entry_Index, Get_Offset_Index, Get_Prim_Op_Kind,
	Register_Tag, Set_Entry_Index, Set_Offset_To_Top, Set_Prim_Op_Kind):
	Remove pragma Inline_Always.

	* rtsfind.ads (Default_Prim_Op_Count): Removed
	(Max_Predef_Prims): New entity
	(RE_Expanded_Name): Removed
	(RE_HT_Link): Removed
	(RE_Iface_Tag): Remmoved
	(RE_Ifaces_Table): Removed
	(RE_Interfaces_Array): Removed
	(RE_Interface_Data_Element): Removed
	(RE_Nb_Ifaces): Removed
	(RE_RC_Offset): Removed
	(RE_Static_Offset_To_Top): Removed

	* exp_atag.ads (Build_Inherit_Prims): Addition of a new formal.
	(Build_Inherit_Predefined_Prims): Replace occurrences of Default_
	Prim_Op_Count by Max_Predef_Prims.

From-SVN: r127438
This commit is contained in:
Javier Miranda 2007-08-14 10:44:53 +02:00 committed by Arnaud Charlet
parent fdcf961c8e
commit 5e1527bd59
4 changed files with 57 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
gcc/ada/a-tags.adb
View File

@ -32,6 +32,7 @@
------------------------------------------------------------------------------
with Ada.Exceptions;
with Ada.Unchecked_Conversion;
with System.HTable;
with System.Storage_Elements; use System.Storage_Elements;
with System.WCh_Con; use System.WCh_Con;
@ -76,9 +77,7 @@ package body Ada.Tags is
pragma Inline_Always (OSD);
pragma Inline_Always (SSD);
---------------------------------------------
-- Unchecked Conversions for String Fields --
---------------------------------------------
-- Unchecked conversions
function To_Address is
new Unchecked_Conversion (Cstring_Ptr, System.Address);
@ -86,16 +85,34 @@ package body Ada.Tags is
function To_Cstring_Ptr is
new Unchecked_Conversion (System.Address, Cstring_Ptr);
-- Disable warnings on possible aliasing problem because we only use
-- use this function to convert tags found in the External_Tag of
-- locally defined tagged types.
pragma Warnings (off);
-- Disable warnings on possible aliasing problem
function To_Tag is
new Unchecked_Conversion (Integer_Address, Tag);
pragma Warnings (on);
function To_Addr_Ptr is
new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);
function To_Address is
new Ada.Unchecked_Conversion (Tag, System.Address);
function To_Dispatch_Table_Ptr is
new Ada.Unchecked_Conversion (Tag, Dispatch_Table_Ptr);
function To_Dispatch_Table_Ptr is
new Ada.Unchecked_Conversion (System.Address, Dispatch_Table_Ptr);
function To_Object_Specific_Data_Ptr is
new Ada.Unchecked_Conversion (System.Address, Object_Specific_Data_Ptr);
function To_Predef_Prims_Table_Ptr is
new Ada.Unchecked_Conversion (System.Address, Predef_Prims_Table_Ptr);
function To_Tag_Ptr is
new Ada.Unchecked_Conversion (System.Address, Tag_Ptr);
function To_Type_Specific_Data_Ptr is
new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
------------------------------------------------
-- Unchecked Conversions for other components --
@ -357,7 +374,7 @@ package body Ada.Tags is
-- If the object does not implement the interface we must raise CE
raise Constraint_Error;
raise Constraint_Error with "invalid interface conversion";
end Displace;
--------

63
gcc/ada/a-tags.ads
View File

@ -37,7 +37,6 @@
with System;
with System.Storage_Elements;
with Ada.Unchecked_Conversion;
package Ada.Tags is
pragma Preelaborate_05;
@ -273,6 +272,7 @@ private
end record;
type Type_Specific_Data_Ptr is access all Type_Specific_Data;
pragma No_Strict_Aliasing (Type_Specific_Data_Ptr);
-- Declarations for the dispatch table record
@ -321,6 +321,8 @@ private
-- gdb, its name must not be changed.
type Tag is access all Dispatch_Table;
pragma No_Strict_Aliasing (Tag);
type Interface_Tag is access all Dispatch_Table;
No_Tag : constant Tag := null;
@ -329,7 +331,10 @@ private
-- of the wrapper.
type Tag_Ptr is access all Tag;
pragma No_Strict_Aliasing (Tag_Ptr);
type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper;
pragma No_Strict_Aliasing (Dispatch_Table_Ptr);
-- The following type declaration is used by the compiler when the program
-- is compiled with restriction No_Dispatching_Calls. It is also used with
@ -341,11 +346,6 @@ private
NDT_Prims_Ptr : Natural;
end record;
Default_Prim_Op_Count : constant Positive := 15;
-- Number of predefined ada primitives: Size, Alignment, Read, Write,
-- Input, Output, "=", assignment, deep adjust, deep finalize, async
-- select, conditional select, prim_op kind, task_id, and timed select.
DT_Predef_Prims_Size : constant SSE.Storage_Count :=
SSE.Storage_Count
(1 * (Standard'Address_Size /
@ -385,6 +385,7 @@ private
end record;
type Object_Specific_Data_Ptr is access all Object_Specific_Data;
pragma No_Strict_Aliasing (Object_Specific_Data_Ptr);
-- The following subprogram specifications are placed here instead of
-- the package body to see them from the frontend through rtsfind.
@ -494,52 +495,16 @@ private
-- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
-- table indexed by Position.
-- Unchecked Conversions
Max_Predef_Prims : constant Natural := 16;
-- Compiler should check this constant is OK ???
Max_Predef_Prims : constant Positive := 15;
-- Number of reserved slots for predefined ada primitives: Size, Alignment,
-- Read, Write, Input, Output, "=", assignment, deep adjust, deep finalize,
-- async select, conditional select, prim_op kind, task_id, and timed
-- select. The compiler checks that this value is correct.
subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims);
type Predef_Prims_Table_Ptr is access Predef_Prims_Table;
pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr);
type Addr_Ptr is access System.Address;
function To_Addr_Ptr is
new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);
function To_Address is
new Ada.Unchecked_Conversion (Tag, System.Address);
function To_Dispatch_Table_Ptr is
new Ada.Unchecked_Conversion (Tag, Dispatch_Table_Ptr);
function To_Dispatch_Table_Ptr is
new Ada.Unchecked_Conversion (System.Address, Dispatch_Table_Ptr);
function To_Object_Specific_Data_Ptr is
new Ada.Unchecked_Conversion (System.Address, Object_Specific_Data_Ptr);
function To_Predef_Prims_Table_Ptr is
new Ada.Unchecked_Conversion (System.Address, Predef_Prims_Table_Ptr);
function To_Tag_Ptr is
new Ada.Unchecked_Conversion (System.Address, Tag_Ptr);
function To_Type_Specific_Data_Ptr is
new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
-- Primitive dispatching operations are always inlined, to facilitate use
-- in a minimal/no run-time environment for high integrity use.
pragma Inline_Always (Displace);
pragma Inline_Always (IW_Membership);
pragma Inline_Always (Get_Entry_Index);
pragma Inline_Always (Get_Offset_Index);
pragma Inline_Always (Get_Prim_Op_Kind);
pragma Inline_Always (Get_Tagged_Kind);
pragma Inline_Always (Register_Tag);
pragma Inline_Always (Set_Entry_Index);
pragma Inline_Always (Set_Offset_To_Top);
pragma Inline_Always (Set_Prim_Op_Kind);
pragma No_Strict_Aliasing (Addr_Ptr);
end Ada.Tags;

10
gcc/ada/exp_atag.ads
View File

@ -32,6 +32,9 @@ with Uintp; use Uintp;
package Exp_Atag is
-- Note: In all the subprograms of this package formal 'Loc' is the source
-- location used in constructing the corresponding nodes.
procedure Build_Common_Dispatching_Select_Statements
(Loc : Source_Ptr;
DT_Ptr : Entity_Id;
@ -100,12 +103,15 @@ package Exp_Atag is
function Build_Inherit_Prims
(Loc : Source_Ptr;
Typ : Entity_Id;
Old_Tag_Node : Node_Id;
New_Tag_Node : Node_Id;
Num_Prims : Nat) return Node_Id;
-- Build code that inherits Num_Prims user-defined primitives from the
-- dispatch table of the parent type. It is used to copy the dispatch
-- table of the parent in case of derivations of CPP_Class types.
-- dispatch table of the parent type of tagged type Typ. It is used to
-- copy the dispatch table of the parent in the following cases:
-- a) case of derivations of CPP_Class types
-- b) tagged types whose dispatch table is not statically allocated
--
-- Generates:
-- New_Tag.Prims_Ptr (1 .. Num_Prims) :=

24
gcc/ada/rtsfind.ads
View File

@ -492,7 +492,6 @@ package Rtsfind is
RE_Addr_Ptr, -- Ada.Tags
RE_Base_Address, -- Ada.Tags
RE_Cstring_Ptr, -- Ada.Tags
RE_Default_Prim_Op_Count, -- Ada.Tags
RE_Descendant_Tag, -- Ada.Tags
RE_Dispatch_Table, -- Ada.Tags
RE_Dispatch_Table_Wrapper, -- Ada.Tags
@ -500,9 +499,7 @@ package Rtsfind is
RE_DT, -- Ada.Tags
RE_DT_Predef_Prims_Offset, -- Ada.Tags
RE_DT_Typeinfo_Ptr_Size, -- Ada.Tags
RE_Expanded_Name, -- Ada.Tags
RE_External_Tag, -- Ada.Tags
RE_HT_Link, -- Ada.Tags
RO_TA_External_Tag, -- Ada.Tags
RE_Get_Access_Level, -- Ada.Tags
RE_Get_Entry_Index, -- Ada.Tags
@ -510,13 +507,13 @@ package Rtsfind is
RE_Get_Prim_Op_Kind, -- Ada.Tags
RE_Get_Tagged_Kind, -- Ada.Tags
RE_Idepth, -- Ada.Tags
RE_Iface_Tag, -- Ada.Tags
RE_Ifaces_Table, -- Ada.Tags
RE_Interfaces_Array, -- Ada.Tags
RE_Interfaces_Table, -- Ada.Tags
RE_Interface_Data, -- Ada.Tags
RE_Interface_Data_Element, -- Ada.Tags
RE_Interface_Tag, -- Ada.Tags
RE_IW_Membership, -- Ada.Tags
RE_Nb_Ifaces, -- Ada.Tags
RE_Max_Predef_Prims, -- Ada.Tags
RE_No_Dispatch_Table_Wrapper, -- Ada.Tags
RE_NDT_Prims_Ptr, -- Ada.Tags
RE_NDT_TSD, -- Ada.Tags
@ -545,13 +542,11 @@ package Rtsfind is
RE_Type_Specific_Data, -- Ada.Tags
RE_Register_Tag, -- Ada.Tags
RE_Transportable, -- Ada.Tags
RE_RC_Offset, -- Ada.Tags
RE_Secondary_DT, -- Ada.Tags
RE_Select_Specific_Data, -- Ada.Tags
RE_Set_Entry_Index, -- Ada.Tags
RE_Set_Offset_To_Top, -- Ada.Tags
RE_Set_Prim_Op_Kind, -- Ada.Tags
RE_Static_Offset_To_Top, -- Ada.Tags
RE_Tag, -- Ada.Tags
RE_Tag_Error, -- Ada.Tags
RE_Tag_Kind, -- Ada.Tags
@ -1050,6 +1045,7 @@ package Rtsfind is
RE_Unspecified_Size, -- System.Parameters
RE_DSA_Implementation, -- System.Partition_Interface
RE_PCS_Version, -- System.Partition_Interface
RE_Get_RCI_Package_Receiver, -- System.Partition_Interface
RE_Get_Unique_Remote_Pointer, -- System.Partition_Interface
RE_RACW_Stub_Type_Access, -- System.Partition_Interface
@ -1598,7 +1594,6 @@ package Rtsfind is
RE_Addr_Ptr => Ada_Tags,
RE_Base_Address => Ada_Tags,
RE_Cstring_Ptr => Ada_Tags,
RE_Default_Prim_Op_Count => Ada_Tags,
RE_Descendant_Tag => Ada_Tags,
RE_Dispatch_Table => Ada_Tags,
RE_Dispatch_Table_Wrapper => Ada_Tags,
@ -1606,9 +1601,7 @@ package Rtsfind is
RE_DT => Ada_Tags,
RE_DT_Predef_Prims_Offset => Ada_Tags,
RE_DT_Typeinfo_Ptr_Size => Ada_Tags,
RE_Expanded_Name => Ada_Tags,
RE_External_Tag => Ada_Tags,
RE_HT_Link => Ada_Tags,
RO_TA_External_Tag => Ada_Tags,
RE_Get_Access_Level => Ada_Tags,
RE_Get_Entry_Index => Ada_Tags,
@ -1616,13 +1609,13 @@ package Rtsfind is
RE_Get_Prim_Op_Kind => Ada_Tags,
RE_Get_Tagged_Kind => Ada_Tags,
RE_Idepth => Ada_Tags,
RE_Iface_Tag => Ada_Tags,
RE_Ifaces_Table => Ada_Tags,
RE_Interfaces_Array => Ada_Tags,
RE_Interfaces_Table => Ada_Tags,
RE_Interface_Data => Ada_Tags,
RE_Interface_Data_Element => Ada_Tags,
RE_Interface_Tag => Ada_Tags,
RE_IW_Membership => Ada_Tags,
RE_Nb_Ifaces => Ada_Tags,
RE_Max_Predef_Prims => Ada_Tags,
RE_No_Dispatch_Table_Wrapper => Ada_Tags,
RE_NDT_Prims_Ptr => Ada_Tags,
RE_NDT_TSD => Ada_Tags,
@ -1651,13 +1644,11 @@ package Rtsfind is
RE_Type_Specific_Data => Ada_Tags,
RE_Register_Tag => Ada_Tags,
RE_Transportable => Ada_Tags,
RE_RC_Offset => Ada_Tags,
RE_Secondary_DT => Ada_Tags,
RE_Select_Specific_Data => Ada_Tags,
RE_Set_Entry_Index => Ada_Tags,
RE_Set_Offset_To_Top => Ada_Tags,
RE_Set_Prim_Op_Kind => Ada_Tags,
RE_Static_Offset_To_Top => Ada_Tags,
RE_Tag => Ada_Tags,
RE_Tag_Error => Ada_Tags,
RE_Tag_Kind => Ada_Tags,
@ -2154,6 +2145,7 @@ package Rtsfind is
RE_Unspecified_Size => System_Parameters,
RE_DSA_Implementation => System_Partition_Interface,
RE_PCS_Version => System_Partition_Interface,
RE_Get_RCI_Package_Receiver => System_Partition_Interface,
RE_Get_Unique_Remote_Pointer => System_Partition_Interface,
RE_RACW_Stub_Type_Access => System_Partition_Interface,