570 lines
25 KiB
Ada
570 lines
25 KiB
Ada
|
------------------------------------------------------------------------------
|
||
|
-- --
|
||
|
-- GNAT RUN-TIME COMPONENTS --
|
||
|
-- --
|
||
|
-- A D A . T A G S --
|
||
|
-- --
|
||
|
-- S p e c --
|
||
|
-- --
|
||
|
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||
|
-- --
|
||
|
-- This specification is derived from the Ada Reference Manual for use with --
|
||
|
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||
|
-- apply solely to the contents of the part following the private keyword. --
|
||
|
-- --
|
||
|
-- 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- --
|
||
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||
|
-- --
|
||
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
||
|
-- version 3.1, as published by the Free Software Foundation. --
|
||
|
-- --
|
||
|
-- You should have received a copy of the GNU General Public License and --
|
||
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||
|
-- <http://www.gnu.org/licenses/>. --
|
||
|
-- --
|
||
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
||
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||
|
-- --
|
||
|
------------------------------------------------------------------------------
|
||
|
|
||
|
with System;
|
||
|
with System.Storage_Elements;
|
||
|
|
||
|
package Ada.Tags is
|
||
|
pragma Preelaborate_05;
|
||
|
-- In accordance with Ada 2005 AI-362
|
||
|
|
||
|
type Tag is private;
|
||
|
pragma Preelaborable_Initialization (Tag);
|
||
|
|
||
|
No_Tag : constant Tag;
|
||
|
|
||
|
function Expanded_Name (T : Tag) return String;
|
||
|
|
||
|
function Wide_Expanded_Name (T : Tag) return Wide_String;
|
||
|
pragma Ada_05 (Wide_Expanded_Name);
|
||
|
|
||
|
function Wide_Wide_Expanded_Name (T : Tag) return Wide_Wide_String;
|
||
|
pragma Ada_05 (Wide_Wide_Expanded_Name);
|
||
|
|
||
|
function External_Tag (T : Tag) return String;
|
||
|
|
||
|
function Internal_Tag (External : String) return Tag;
|
||
|
|
||
|
function Descendant_Tag
|
||
|
(External : String;
|
||
|
Ancestor : Tag) return Tag;
|
||
|
pragma Ada_05 (Descendant_Tag);
|
||
|
|
||
|
function Is_Descendant_At_Same_Level
|
||
|
(Descendant : Tag;
|
||
|
Ancestor : Tag) return Boolean;
|
||
|
pragma Ada_05 (Is_Descendant_At_Same_Level);
|
||
|
|
||
|
function Parent_Tag (T : Tag) return Tag;
|
||
|
pragma Ada_05 (Parent_Tag);
|
||
|
|
||
|
type Tag_Array is array (Positive range <>) of Tag;
|
||
|
|
||
|
function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
|
||
|
pragma Ada_05 (Interface_Ancestor_Tags);
|
||
|
|
||
|
Tag_Error : exception;
|
||
|
|
||
|
private
|
||
|
-- Structure of the GNAT Primary Dispatch Table
|
||
|
|
||
|
-- +--------------------+
|
||
|
-- | Signature |
|
||
|
-- +--------------------+
|
||
|
-- | Tagged_Kind |
|
||
|
-- +--------------------+ Predef Prims
|
||
|
-- | Predef_Prims -----------------------------> +------------+
|
||
|
-- +--------------------+ | table of |
|
||
|
-- | Offset_To_Top | | predefined |
|
||
|
-- +--------------------+ | primitives |
|
||
|
-- |Typeinfo_Ptr/TSD_Ptr---> Type Specific Data +------------+
|
||
|
-- Tag ---> +--------------------+ +-------------------+
|
||
|
-- | table of | | inheritance depth |
|
||
|
-- : primitive ops : +-------------------+
|
||
|
-- | pointers | | access level |
|
||
|
-- +--------------------+ +-------------------+
|
||
|
-- | expanded name |
|
||
|
-- +-------------------+
|
||
|
-- | external tag |
|
||
|
-- +-------------------+
|
||
|
-- | hash table link |
|
||
|
-- +-------------------+
|
||
|
-- | remotely callable |
|
||
|
-- +-------------------+
|
||
|
-- | rec ctrler offset |
|
||
|
-- +-------------------+
|
||
|
-- | Ifaces_Table ---> Interface Data
|
||
|
-- +-------------------+ +------------+
|
||
|
-- Select Specific Data <---- SSD | | Nb_Ifaces |
|
||
|
-- +------------------+ +-------------------+ +------------+
|
||
|
-- |table of primitive| | table of | | table |
|
||
|
-- : operation : : ancestor : : of :
|
||
|
-- | kinds | | tags | | interfaces |
|
||
|
-- +------------------+ +-------------------+ +------------+
|
||
|
-- |table of |
|
||
|
-- : entry :
|
||
|
-- | indices |
|
||
|
-- +------------------+
|
||
|
|
||
|
-- Structure of the GNAT Secondary Dispatch Table
|
||
|
|
||
|
-- +--------------------+
|
||
|
-- | Signature |
|
||
|
-- +--------------------+
|
||
|
-- | Tagged_Kind |
|
||
|
-- +--------------------+ Predef Prims
|
||
|
-- | Predef_Prims -----------------------------> +------------+
|
||
|
-- +--------------------+ | table of |
|
||
|
-- | Offset_To_Top | | predefined |
|
||
|
-- +--------------------+ | primitives |
|
||
|
-- | OSD_Ptr |---> Object Specific Data | thunks |
|
||
|
-- Tag ---> +--------------------+ +---------------+ +------------+
|
||
|
-- | table of | | num prim ops |
|
||
|
-- : primitive op : +---------------+
|
||
|
-- | thunk pointers | | table of |
|
||
|
-- +--------------------+ + primitive |
|
||
|
-- | op offsets |
|
||
|
-- +---------------+
|
||
|
|
||
|
-- The runtime information kept for each tagged type is separated into two
|
||
|
-- objects: the Dispatch Table and the Type Specific Data record.
|
||
|
|
||
|
package SSE renames System.Storage_Elements;
|
||
|
|
||
|
subtype Cstring is String (Positive);
|
||
|
type Cstring_Ptr is access all Cstring;
|
||
|
pragma No_Strict_Aliasing (Cstring_Ptr);
|
||
|
|
||
|
-- Declarations for the table of interfaces
|
||
|
|
||
|
type Offset_To_Top_Function_Ptr is
|
||
|
access function (This : System.Address) return SSE.Storage_Offset;
|
||
|
-- Type definition used to call the function that is generated by the
|
||
|
-- expander in case of tagged types with discriminants that have secondary
|
||
|
-- dispatch tables. This function provides the Offset_To_Top value in this
|
||
|
-- specific case.
|
||
|
|
||
|
type Interface_Data_Element is record
|
||
|
Iface_Tag : Tag;
|
||
|
Static_Offset_To_Top : Boolean;
|
||
|
Offset_To_Top_Value : SSE.Storage_Offset;
|
||
|
Offset_To_Top_Func : Offset_To_Top_Function_Ptr;
|
||
|
Secondary_DT : Tag;
|
||
|
end record;
|
||
|
-- If some ancestor of the tagged type has discriminants the field
|
||
|
-- Static_Offset_To_Top is False and the field Offset_To_Top_Func
|
||
|
-- is used to store the access to the function generated by the
|
||
|
-- expander which provides this value; otherwise Static_Offset_To_Top
|
||
|
-- is True and such value is stored in the Offset_To_Top_Value field.
|
||
|
-- Secondary_DT references a secondary dispatch table whose contents
|
||
|
-- are pointers to the primitives of the tagged type that cover the
|
||
|
-- interface primitives. Secondary_DT gives support to dispatching
|
||
|
-- calls through interface types associated with Generic Dispatching
|
||
|
-- Constructors.
|
||
|
|
||
|
type Interfaces_Array is array (Natural range <>) of Interface_Data_Element;
|
||
|
|
||
|
type Interface_Data (Nb_Ifaces : Positive) is record
|
||
|
Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
|
||
|
end record;
|
||
|
|
||
|
type Interface_Data_Ptr is access all Interface_Data;
|
||
|
-- Table of abstract interfaces used to give support to backward interface
|
||
|
-- conversions and also to IW_Membership.
|
||
|
|
||
|
-- Primitive operation kinds. These values differentiate the kinds of
|
||
|
-- callable entities stored in the dispatch table. Certain kinds may
|
||
|
-- not be used, but are added for completeness.
|
||
|
|
||
|
type Prim_Op_Kind is
|
||
|
(POK_Function,
|
||
|
POK_Procedure,
|
||
|
POK_Protected_Entry,
|
||
|
POK_Protected_Function,
|
||
|
POK_Protected_Procedure,
|
||
|
POK_Task_Entry,
|
||
|
POK_Task_Function,
|
||
|
POK_Task_Procedure);
|
||
|
|
||
|
-- Select specific data types
|
||
|
|
||
|
type Select_Specific_Data_Element is record
|
||
|
Index : Positive;
|
||
|
Kind : Prim_Op_Kind;
|
||
|
end record;
|
||
|
|
||
|
type Select_Specific_Data_Array is
|
||
|
array (Positive range <>) of Select_Specific_Data_Element;
|
||
|
|
||
|
type Select_Specific_Data (Nb_Prim : Positive) is record
|
||
|
SSD_Table : Select_Specific_Data_Array (1 .. Nb_Prim);
|
||
|
-- NOTE: Nb_Prim is the number of non-predefined primitive operations
|
||
|
end record;
|
||
|
|
||
|
type Select_Specific_Data_Ptr is access all Select_Specific_Data;
|
||
|
-- A table used to store the primitive operation kind and entry index of
|
||
|
-- primitive subprograms of a type that implements a limited interface.
|
||
|
-- The Select Specific Data table resides in the Type Specific Data of a
|
||
|
-- type. This construct is used in the handling of dispatching triggers
|
||
|
-- in select statements.
|
||
|
|
||
|
type Prim_Ptr is access procedure;
|
||
|
type Address_Array is array (Positive range <>) of Prim_Ptr;
|
||
|
|
||
|
subtype Dispatch_Table is Address_Array (1 .. 1);
|
||
|
-- Used by GDB to identify the _tags and traverse the run-time structure
|
||
|
-- associated with tagged types. For compatibility with older versions of
|
||
|
-- 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;
|
||
|
|
||
|
-- The expander ensures that Tag objects reference the Prims_Ptr component
|
||
|
-- of the wrapper.
|
||
|
|
||
|
type Tag_Ptr is access all Tag;
|
||
|
pragma No_Strict_Aliasing (Tag_Ptr);
|
||
|
|
||
|
type Offset_To_Top_Ptr is access all SSE.Storage_Offset;
|
||
|
pragma No_Strict_Aliasing (Offset_To_Top_Ptr);
|
||
|
|
||
|
type Tag_Table is array (Natural range <>) of Tag;
|
||
|
|
||
|
type Size_Ptr is
|
||
|
access function (A : System.Address) return Long_Long_Integer;
|
||
|
|
||
|
type Type_Specific_Data (Idepth : Natural) is record
|
||
|
-- The discriminant Idepth is the Inheritance Depth Level: Used to
|
||
|
-- implement the membership test associated with single inheritance of
|
||
|
-- tagged types in constant-time. It also indicates the size of the
|
||
|
-- Tags_Table component.
|
||
|
|
||
|
Access_Level : Natural;
|
||
|
-- Accessibility level required to give support to Ada 2005 nested type
|
||
|
-- extensions. This feature allows safe nested type extensions by
|
||
|
-- shifting the accessibility checks to certain operations, rather than
|
||
|
-- being enforced at the type declaration. In particular, by performing
|
||
|
-- run-time accessibility checks on class-wide allocators, class-wide
|
||
|
-- function return, and class-wide stream I/O, the danger of objects
|
||
|
-- outliving their type declaration can be eliminated (Ada 2005: AI-344)
|
||
|
|
||
|
Expanded_Name : Cstring_Ptr;
|
||
|
External_Tag : Cstring_Ptr;
|
||
|
HT_Link : Tag_Ptr;
|
||
|
-- Components used to support to the Ada.Tags subprograms in RM 3.9
|
||
|
|
||
|
-- Note: Expanded_Name is referenced by GDB to determine the actual name
|
||
|
-- of the tagged type. Its requirements are: 1) it must have this exact
|
||
|
-- name, and 2) its contents must point to a C-style Nul terminated
|
||
|
-- string containing its expanded name. GDB has no requirement on a
|
||
|
-- given position inside the record.
|
||
|
|
||
|
Transportable : Boolean;
|
||
|
-- Used to check RM E.4(18), set for types that satisfy the requirements
|
||
|
-- for being used in remote calls as actuals for classwide formals or as
|
||
|
-- return values for classwide functions.
|
||
|
|
||
|
RC_Offset : SSE.Storage_Offset;
|
||
|
-- Controller Offset: Used to give support to tagged controlled objects
|
||
|
-- (see Get_Deep_Controller at s-finimp)
|
||
|
|
||
|
Size_Func : Size_Ptr;
|
||
|
-- Pointer to the subprogram computing the _size of the object. Used by
|
||
|
-- the run-time whenever a call to the 'size primitive is required. We
|
||
|
-- cannot assume that the contents of dispatch tables are addresses
|
||
|
-- because in some architectures the ABI allows descriptors.
|
||
|
|
||
|
Interfaces_Table : Interface_Data_Ptr;
|
||
|
-- Pointer to the table of interface tags. It is used to implement the
|
||
|
-- membership test associated with interfaces and also for backward
|
||
|
-- abstract interface type conversions (Ada 2005:AI-251)
|
||
|
|
||
|
SSD : Select_Specific_Data_Ptr;
|
||
|
-- Pointer to a table of records used in dispatching selects. This
|
||
|
-- field has a meaningful value for all tagged types that implement
|
||
|
-- a limited, protected, synchronized or task interfaces and have
|
||
|
-- non-predefined primitive operations.
|
||
|
|
||
|
Tags_Table : Tag_Table (0 .. Idepth);
|
||
|
-- Table of ancestor tags. Its size actually depends on the inheritance
|
||
|
-- depth level of the tagged type.
|
||
|
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
|
||
|
|
||
|
type Signature_Kind is
|
||
|
(Unknown,
|
||
|
Primary_DT,
|
||
|
Secondary_DT);
|
||
|
|
||
|
-- Tagged type kinds with respect to concurrency and limitedness
|
||
|
|
||
|
type Tagged_Kind is
|
||
|
(TK_Abstract_Limited_Tagged,
|
||
|
TK_Abstract_Tagged,
|
||
|
TK_Limited_Tagged,
|
||
|
TK_Protected,
|
||
|
TK_Tagged,
|
||
|
TK_Task);
|
||
|
|
||
|
type Dispatch_Table_Wrapper (Num_Prims : Natural) is record
|
||
|
Signature : Signature_Kind;
|
||
|
Tag_Kind : Tagged_Kind;
|
||
|
Predef_Prims : System.Address;
|
||
|
-- Pointer to the dispatch table of predefined Ada primitives
|
||
|
|
||
|
-- According to the C++ ABI the components Offset_To_Top and TSD are
|
||
|
-- stored just "before" the dispatch table, and they are referenced with
|
||
|
-- negative offsets referring to the base of the dispatch table. The
|
||
|
-- _Tag (or the VTable_Ptr in C++ terminology) must point to the base
|
||
|
-- of the virtual table, just after these components, to point to the
|
||
|
-- Prims_Ptr table.
|
||
|
|
||
|
Offset_To_Top : SSE.Storage_Offset;
|
||
|
TSD : System.Address;
|
||
|
|
||
|
Prims_Ptr : aliased Address_Array (1 .. Num_Prims);
|
||
|
-- The size of the Prims_Ptr array actually depends on the tagged type
|
||
|
-- to which it applies. For each tagged type, the expander computes the
|
||
|
-- actual array size, allocates the Dispatch_Table record accordingly.
|
||
|
end record;
|
||
|
|
||
|
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
|
||
|
-- interface types to generate the tag and run-time information associated
|
||
|
-- with them.
|
||
|
|
||
|
type No_Dispatch_Table_Wrapper is record
|
||
|
NDT_TSD : System.Address;
|
||
|
NDT_Prims_Ptr : Natural;
|
||
|
end record;
|
||
|
|
||
|
DT_Predef_Prims_Size : constant SSE.Storage_Count :=
|
||
|
SSE.Storage_Count
|
||
|
(1 * (Standard'Address_Size /
|
||
|
System.Storage_Unit));
|
||
|
-- Size of the Predef_Prims field of the Dispatch_Table
|
||
|
|
||
|
DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
|
||
|
SSE.Storage_Count
|
||
|
(1 * (Standard'Address_Size /
|
||
|
System.Storage_Unit));
|
||
|
-- Size of the Offset_To_Top field of the Dispatch Table
|
||
|
|
||
|
DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
|
||
|
SSE.Storage_Count
|
||
|
(1 * (Standard'Address_Size /
|
||
|
System.Storage_Unit));
|
||
|
-- Size of the Typeinfo_Ptr field of the Dispatch Table
|
||
|
|
||
|
use type System.Storage_Elements.Storage_Offset;
|
||
|
|
||
|
DT_Offset_To_Top_Offset : constant SSE.Storage_Count :=
|
||
|
DT_Typeinfo_Ptr_Size
|
||
|
+ DT_Offset_To_Top_Size;
|
||
|
|
||
|
DT_Predef_Prims_Offset : constant SSE.Storage_Count :=
|
||
|
DT_Typeinfo_Ptr_Size
|
||
|
+ DT_Offset_To_Top_Size
|
||
|
+ DT_Predef_Prims_Size;
|
||
|
-- Offset from Prims_Ptr to Predef_Prims component
|
||
|
|
||
|
-- Object Specific Data record of secondary dispatch tables
|
||
|
|
||
|
type Object_Specific_Data_Array is array (Positive range <>) of Positive;
|
||
|
|
||
|
type Object_Specific_Data (OSD_Num_Prims : Positive) is record
|
||
|
OSD_Table : Object_Specific_Data_Array (1 .. OSD_Num_Prims);
|
||
|
-- Table used in secondary DT to reference their counterpart in the
|
||
|
-- select specific data (in the TSD of the primary DT). This construct
|
||
|
-- is used in the handling of dispatching triggers in select statements.
|
||
|
-- Nb_Prim is the number of non-predefined primitive operations.
|
||
|
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.
|
||
|
|
||
|
function Base_Address (This : System.Address) return System.Address;
|
||
|
-- Ada 2005 (AI-251): Displace "This" to point to the base address of
|
||
|
-- the object (that is, the address of the primary tag of the object).
|
||
|
|
||
|
function Displace (This : System.Address; T : Tag) return System.Address;
|
||
|
-- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
|
||
|
-- table of T.
|
||
|
|
||
|
function Secondary_Tag (T, Iface : Tag) return Tag;
|
||
|
-- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type
|
||
|
-- Typ, search for the secondary tag of the interface type Iface covered
|
||
|
-- by Typ.
|
||
|
|
||
|
function DT (T : Tag) return Dispatch_Table_Ptr;
|
||
|
-- Return the pointer to the TSD record associated with T
|
||
|
|
||
|
function Get_Entry_Index (T : Tag; Position : Positive) return Positive;
|
||
|
-- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
|
||
|
-- given a dispatch table T and a position of a primitive operation in T.
|
||
|
|
||
|
function Get_Offset_Index
|
||
|
(T : Tag;
|
||
|
Position : Positive) return Positive;
|
||
|
-- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T) and
|
||
|
-- a position of an operation in the DT, retrieve the corresponding
|
||
|
-- operation's position in the primary dispatch table from the Offset
|
||
|
-- Specific Data table of T.
|
||
|
|
||
|
function Get_Prim_Op_Kind
|
||
|
(T : Tag;
|
||
|
Position : Positive) return Prim_Op_Kind;
|
||
|
-- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
|
||
|
-- table T and a position of a primitive operation in T.
|
||
|
|
||
|
function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
|
||
|
-- Return the Offset of the implicit record controller when the object
|
||
|
-- has controlled components, returns zero if no controlled components.
|
||
|
|
||
|
pragma Export (Ada, Get_RC_Offset, "ada__tags__get_rc_offset");
|
||
|
-- This procedure is used in s-finimp to compute the deep routines
|
||
|
-- it is exported manually in order to avoid changing completely the
|
||
|
-- organization of the run time.
|
||
|
|
||
|
function Get_Tagged_Kind (T : Tag) return Tagged_Kind;
|
||
|
-- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
|
||
|
-- dispatch table, return the tagged kind of a type in the context of
|
||
|
-- concurrency and limitedness.
|
||
|
|
||
|
function IW_Membership (This : System.Address; T : Tag) return Boolean;
|
||
|
-- Ada 2005 (AI-251): General routine that checks if a given object
|
||
|
-- implements a tagged type. Its common usage is to check if Obj is in
|
||
|
-- Iface'Class, but it is also used to check if a class-wide interface
|
||
|
-- implements a given type (Iface_CW_Typ in T'Class). For example:
|
||
|
--
|
||
|
-- type I is interface;
|
||
|
-- type T is tagged ...
|
||
|
--
|
||
|
-- function Test (O : I'Class) is
|
||
|
-- begin
|
||
|
-- return O in T'Class.
|
||
|
-- end Test;
|
||
|
|
||
|
function Offset_To_Top
|
||
|
(This : System.Address) return SSE.Storage_Offset;
|
||
|
-- Ada 2005 (AI-251): Returns the current value of the offset_to_top
|
||
|
-- component available in the prologue of the dispatch table. If the parent
|
||
|
-- of the tagged type has discriminants this value is stored in a record
|
||
|
-- component just immediately after the tag component.
|
||
|
|
||
|
function Parent_Size
|
||
|
(Obj : System.Address;
|
||
|
T : Tag) return SSE.Storage_Count;
|
||
|
-- Computes the size the ancestor part of a tagged extension object whose
|
||
|
-- address is 'obj' by calling indirectly the ancestor _size function. The
|
||
|
-- ancestor is the parent of the type represented by tag T. This function
|
||
|
-- assumes that _size is always in slot one of the dispatch table.
|
||
|
|
||
|
pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
|
||
|
-- This procedure is used in s-finimp and is thus exported manually
|
||
|
|
||
|
procedure Register_Interface_Offset
|
||
|
(This : System.Address;
|
||
|
Interface_T : Tag;
|
||
|
Is_Static : Boolean;
|
||
|
Offset_Value : SSE.Storage_Offset;
|
||
|
Offset_Func : Offset_To_Top_Function_Ptr);
|
||
|
-- Register in the table of interfaces of the tagged type associated with
|
||
|
-- "This" object the offset of the record component associated with the
|
||
|
-- progenitor Interface_T (that is, the distance from "This" to the object
|
||
|
-- component containing the tag of the secondary dispatch table). In case
|
||
|
-- of constant offset, Is_Static is true and Offset_Value has such value.
|
||
|
-- In case of variable offset, Is_Static is false and Offset_Func is an
|
||
|
-- access to function that must be called to evaluate the offset.
|
||
|
|
||
|
procedure Register_Tag (T : Tag);
|
||
|
-- Insert the Tag and its associated external_tag in a table for the
|
||
|
-- sake of Internal_Tag
|
||
|
|
||
|
procedure Set_Dynamic_Offset_To_Top
|
||
|
(This : System.Address;
|
||
|
Interface_T : Tag;
|
||
|
Offset_Value : SSE.Storage_Offset;
|
||
|
Offset_Func : Offset_To_Top_Function_Ptr);
|
||
|
-- Ada 2005 (AI-251): The compiler generates calls to this routine only
|
||
|
-- when initializing the Offset_To_Top field of dispatch tables associated
|
||
|
-- with tagged type whose parent has variable size components. "This" is
|
||
|
-- the object whose dispatch table is being initialized. Interface_T is the
|
||
|
-- interface for which the secondary dispatch table is being initialized,
|
||
|
-- and Offset_Value is the distance from "This" to the object component
|
||
|
-- containing the tag of the secondary dispatch table (a zero value means
|
||
|
-- that this interface shares the primary dispatch table). Offset_Func
|
||
|
-- references a function that must be called to evaluate the offset at
|
||
|
-- runtime. This routine also takes care of registering these values in
|
||
|
-- the table of interfaces of the type.
|
||
|
|
||
|
procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
|
||
|
-- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
|
||
|
-- TSD table indexed by Position.
|
||
|
|
||
|
procedure Set_Prim_Op_Kind
|
||
|
(T : Tag;
|
||
|
Position : Positive;
|
||
|
Value : Prim_Op_Kind);
|
||
|
-- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
|
||
|
-- table indexed by Position.
|
||
|
|
||
|
Max_Predef_Prims : constant Positive := 16;
|
||
|
-- Number of reserved slots for the following predefined ada primitives:
|
||
|
--
|
||
|
-- 1. Size
|
||
|
-- 2. Alignment,
|
||
|
-- 3. Read
|
||
|
-- 4. Write
|
||
|
-- 5. Input
|
||
|
-- 6. Output
|
||
|
-- 7. "="
|
||
|
-- 8. assignment
|
||
|
-- 9. deep adjust
|
||
|
-- 10. deep finalize
|
||
|
-- 11. async select
|
||
|
-- 12. conditional select
|
||
|
-- 13. prim_op kind
|
||
|
-- 14. task_id
|
||
|
-- 15. dispatching requeue
|
||
|
-- 16. timed select
|
||
|
--
|
||
|
-- The compiler checks that the value here 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;
|
||
|
pragma No_Strict_Aliasing (Addr_Ptr);
|
||
|
-- This type is used by the frontend to generate the code that handles
|
||
|
-- dispatch table slots of types declared at the local level.
|
||
|
|
||
|
end Ada.Tags;
|